Subversion Repositories DevTools

Rev

Rev 3423 | Go to most recent revision | Details | Compare with Previous | Last modification | View Log | RSS feed

Rev Author Line No. Line
3410 dpurdie 1 
#! /usr/bin/perl
2 
########################################################################
3 
# Copyright (C) 2010 Vix-ERG Limited, All rights reserved
4 
#
3423 dpurdie 5 
# Module name   : scan_release.pl
3410 dpurdie 6 
# Module type   : Makefile system
7 
# Compiler(s)   : Perl
8 
# Environment(s): jats
9 
#
10 
# Description   : Scan the Releases area looking for bad symlinks
11 
#
12 
#
13 
#......................................................................#
14 
 
15 
require 5.008_002;
16 
use strict;
17 
use warnings;
18 
 
19 
my $root = $ARGV[0] || die ("Need to specify root directory");
20 
 
21 
#
22 
#   Process ech directory
23 
#
3423 dpurdie 24 
unless ( -d $root )
25 
{
26 
    print "scan_release: Not a directory: $root\n";
27 
    exit 1;
28 
}
3410 dpurdie 29 
 
3423 dpurdie 30 
scan_dir( $root );
31 
exit 0;
32 
 
3410 dpurdie 33 
#-------------------------------------------------------------------------------
34 
# Function        : scan_dir
35 
#
36 
# Description     : Scan a list of directoires for bad links
37 
#
38 
# Inputs          : List of directories to scan
39 
#
40 
sub scan_dir
41 
{
42 
    foreach my $dir ( @_ )
43 
    {
44 
        my @dirs;
45 
#        print "Scanning: $dir\n";
46 
        #
47 
        #   Read in the directory entries
48 
        #
49 
        next if ( ! -d $dir );
4127 dpurdie 50 
        unless ( opendir(my $dh, $dir) )
51 
        {
52 
            my  $mode = (stat($dir))[2];
53 
            printf("Cannot readdir $dir: $!, Mode:%04o\n", $mode & 07777);
54 
            next;
55 
        }
3410 dpurdie 56 
        my @entries = readdir($dh);
57 
        closedir $dh;
58 
 
59 
        #
60 
        #   Process each entry
61 
        #
62 
        foreach my $entry ( @entries )
63 
        {
3423 dpurdie 64 
            next if ( $entry eq '.' );
65 
            next if ( $entry eq '..' );
66 
            next if ( $entry eq 'core_devl' );
67 
            next if ( $entry eq 'lost+found' );
68 
 
3410 dpurdie 69 
            $entry = "$dir/$entry";
70 
            if ( -d $entry )
71 
            {
72 
                push @dirs, $entry;
73 
                next;
74 
            }
75 
 
76 
            if ( -l $entry )
77 
            {
78 
                my $linkfile = readlink( $entry );
79 
 
80 
                #
81 
                #   Broken ?
82 
                #
83 
                if ( ! -e $entry )
84 
                {
85 
                    print "Broken link: $entry ---> $linkfile\n";
86 
                    next;
87 
                }
88 
 
89 
                #
90 
                #   Allowed to be relative
91 
                #       ie: ../ or someDir
92 
                #
93 
                next unless ( $linkfile =~ m~^/~ );
94 
 
95 
                #
3423 dpurdie 96 
                #   Allowed to be a link to a file in the same directory
3410 dpurdie 97 
                #
3423 dpurdie 98 
                next unless ( $linkfile =~ m~/~ );
3410 dpurdie 99 
 
3423 dpurdie 100 
                #
101 
                #   Absolute links are not good
102 
                #
103 
                print "Absolute Link: $entry ---> $linkfile\n";
3410 dpurdie 104 
            }
105 
        }
106 
        scan_dir( @dirs );
107 
    }
108 
}
109