git.gag.com Git - debian/efibootmgr/blob - 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