← Back to branch summary

~ubuntu-branches/ubuntu/lucid/efibootmgr/lucid

« back to all changes in this revision

Viewing changes to tools/install.pl

  • Committer: Bazaar Package Importer
  • Author(s): Bdale Garbee
  • Date: 2002-03-30 13:53:32 UTC
  • Revision ID: james.westby@ubuntu.com-20020330135332-3l2qicrkpm8v4ex4
Tags: upstream-0.3.4
Import upstream version 0.3.4

Show diffs side-by-side

added added

removed removed

Lines of Context:
tools/install.pl
 
1
#!/usr/bin/perl -w
 
2
 
 
3
#Pragmas 
 
4
        use strict;
 
5
 
 
6
#Parse command line...
 
7
        my ($copy, $link);
 
8
        my $type = shift @ARGV;
 
9
        if( $type =~ /^copy$/i ) {
 
10
          $copy = 1;
 
11
        } 
 
12
        if( $type =~ /^link$/i ) {
 
13
          $link = 1;
 
14
        }
 
15
 
 
16
#Main program loop
 
17
        open (RPMOUT, "> filelist-rpm") or die;
 
18
 
 
19
        while( <> ){
 
20
                chomp;
 
21
                s/^\s*//;
 
22
                s/\s*$//;
 
23
                s/\s*#.*$//;
 
24
                next if m/^$/;
 
25
        
 
26
                my $line = $_;
 
27
                ($line =~ m/^R...:(.*)/)  && print RPMOUT $1 . "\n";
 
28
                ($line =~ m/^..M.:(.*)/)  && MakeDir( $1 );
 
29
                ($line =~ m/^.C..:(.*)/)  && ($copy) && CopyFile( $1 );
 
30
                ($line =~ m/^.C..:(.*)/)  && ($link) && LinkFile( $1 );
 
31
                ($line =~ m/^R...:(.*)/)  && ChangeAttrs( $1 );
 
32
        }
 
33
 
 
34
sub CopyFile {
 
35
        my ($src, $dst) = ParseCLine( shift );
 
36
 
 
37
        if( -d $dst ) {
 
38
                $src =~ m|^.*/(.*)$|;
 
39
                my $file = $1;
 
40
                $dst .= "/" if ! ($dst=~m|/$|);
 
41
                $dst .= $file;
 
42
        }
 
43
        if( -e $dst ) {
 
44
                unlink $dst;
 
45
        }
 
46
 
 
47
        open INPUT, "<", $src or goto out1;
 
48
        open OUTPUT, ">", $dst or goto out2;
 
49
        while(<INPUT>){ print OUTPUT $_ }
 
50
        close OUTPUT;
 
51
 
 
52
        print "Installed File: $dst\n";
 
53
out2:
 
54
        close INPUT;
 
55
out1:   
 
56
        return; 
 
57
}
 
58
 
 
59
sub LinkFile {
 
60
        my ($src, $dst) = ParseCLine( shift );
 
61
        if( -d $dst ) {
 
62
                $src =~ m|^.*/(.*)$|;
 
63
                my $file = $1;
 
64
                $dst .= "/" if ! ($dst=~m|/$|);
 
65
                $dst .= $file;
 
66
        }
 
67
        if( -e $dst ) {
 
68
                unlink $dst;
 
69
        }
 
70
        symlink $src, $dst 
 
71
           or warn "Linking $src to $dst failed $!\n";
 
72
        print "Installed File: $dst\n";
 
73
}
 
74
 
 
75
sub ParseCLine {
 
76
        my $line = shift;
 
77
        $line =~ s/^\s*//;
 
78
        $line =~ s/\s*$//;
 
79
        $line =~ m/^(.*?)\s+(.*?)$/;
 
80
        return ($1, $2);
 
81
}
 
82
 
 
83
sub ParseRLine {
 
84
        my $line = shift;
 
85
        my @directives;
 
86
        my @retval;
 
87
        $line =~ s/^\s*//;
 
88
        $line =~ s/\s*$//;
 
89
        my @words = split( /\s+/, $line );
 
90
        foreach my $word (@words) {
 
91
                if( $word =~ /^\%(.*)/ ) {
 
92
                        push @directives, $word;
 
93
                } else {
 
94
                        push @retval, $word;
 
95
                }
 
96
        }
 
97
        return \@retval, \@directives;
 
98
}
 
99
 
 
100
sub MakeDir {
 
101
        #R-M-: %attr(0755,root,ali) /opt/ali
 
102
        my $line = shift;
 
103
 
 
104
        #$line =~ m/\%attr\((.{1,5}),(\w+),(\w+)\)\s+(.*)/;
 
105
        my ($file_ref, $directive_ref) = ParseRLine( $line );
 
106
        
 
107
        my $dir = $file_ref->[0];
 
108
 
 
109
        if( ! -d $dir ) {
 
110
                mkdir $dir 
 
111
                  or warn "Make Dir: -->$dir<-- failed $!\n";
 
112
        }
 
113
        print "Made Dir: $dir\n";
 
114
}
 
115
 
 
116
sub GetUID {
 
117
        my $name = shift;
 
118
        my (undef, undef, $uid, undef) = getpwnam( $name ) ;
 
119
        $uid = defined($uid) ? $uid : -1;
 
120
        return $uid;
 
121
}
 
122
 
 
123
sub GetGID {
 
124
        my $name = shift;
 
125
        my (undef, undef, $gid, undef) = getgrnam( $name ) ;
 
126
        $gid = defined($gid) ? $gid : -1;
 
127
        return $gid;
 
128
}
 
129
 
 
130
sub ChangeAttrs {
 
131
        my $line = shift;
 
132
 
 
133
        my ($file_ref, $directive_ref) = ParseRLine( $line );
 
134
        my ($attr) = grep { /^\%attr/ } @$directive_ref;
 
135
        $attr =~ m/\%attr\((.{1,5}),(\w+),(\w+)\)/;
 
136
        my $perms = $1;
 
137
        my $owner = $2;
 
138
        my $group = $3;
 
139
        my $file = $file_ref->[0];
 
140
 
 
141
        my $uid = GetUID($owner);
 
142
        my $gid = GetGID($group); 
 
143
 
 
144
        chown $uid, $gid, $file;
 
145
        chmod oct($perms), $file;
 
146
}
 
147
 
 
148
 
 
149
 
 
150
 
 
151
 
 
152
 
 
153
 
 
154
 
 
155
 
 
156