dh_suidregister

   1 #!/usr/bin/perl -w
   2 #
   3 # If no parameters are given, and no debian/suid files exists, scan for
   4 # suid/sgid files and suidregister them.
   5 #
   6 # If there are parameters, or there is a debian/suid, register the files
   7 # listed there.
   8
   9 use Debian::Debhelper::Dh_Lib;
  10 init();
  11
  12 foreach $PACKAGE (@{$dh{DOPACKAGES}}) {
  13         $TMP=tmpdir($PACKAGE);
  14         $suid=pkgfile($PACKAGE,"suid");
  15
  16         @files=();
  17         if ($suid) {
  18                 @files=filearray($suid, $TMP);
  19         }
  20
  21         if (($PACKAGE eq $dh{FIRSTPACKAGE} || $dh{PARAMS_ALL}) && @ARGV) {
  22                 push @files, @ARGV;
  23         }
  24
  25         if (! @files && ! $suid) {
  26                 # No files specified (and no empty debian/suid file), so
  27                 # guess what files to process.
  28                 @files=split(/\n/,`find $TMP -type f -perm +6000`);
  29
  30                 # We will strip the debian working directory off of the
  31                 # filenames.
  32                 $tostrip="$TMP/";
  33         }
  34         else {
  35                 # We will strip leading /'s, so the user can feed this
  36                 # program either absolute filenames, or relative filenames,
  37                 # and it will do the right thing either way.
  38                 $tostrip="/";
  39         }
  40
  41         # Register files with suidregister.
  42         foreach $file (@files) {
  43                 # Strip leading $tostrip from $file.
  44                 $file=~s/^$tostrip//;
  45
  46                 if (! -e "$TMP/$file") {
  47                         error("\"$TMP/$file\" does not exist.");
  48                 }
  49
  50                 # Create the sed string that will be used to
  51                 # fill in the blanks in the autoscript files.
  52                 # Fill with the owner, group, and perms of the file.
  53                 (undef,undef,$mode,undef,$uid,$gid,undef) = stat("$TMP/$file");
  54                 # Now come up with the user and group names for the uid and gid.
  55                 $user=getpwuid($uid);
  56                 if (! defined $user) {
  57                         warning("$file has odd uid $uid, not in /etc/passwd");
  58                         $user=$uid;
  59                 }
  60                 $group=getgrgid($gid);
  61                 if (! defined $group) {
  62                         warning("$file has odd gid $gid not in /etc/group");
  63                         $group=$gid;
  64                 }
  65                 # Note that I have to print mode in ocal, stripping file type.
  66                 $sedstr=sprintf("s:#FILE#:$file:;s/#PACKAGE#/$PACKAGE/;s/#OWNER#/$user/;s/#GROUP#/$group/;s/#PERMS#/%#o/",
  67                                 $mode & 07777);
  68
  69                 autoscript($PACKAGE,"postinst","postinst-suid",$sedstr);
  70                 autoscript($PACKAGE,"postrm","postrm-suid","$sedstr");
  71         }
  72
  73         # Remove suid bits from files. This is delayed to this point, because
  74         # of a situation with hard linked files if it is done earlier.
  75         # See changelog for 2.0.77.
  76         foreach $file (@files) {
  77                 if ( -e "$TMP/$file") {
  78                         doit("chmod","a-s","$TMP/$file");
  79                 }
  80         }
  81 }