dpkg-statoverride.pl 6.0 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248
  1. #! /usr/bin/perl
  2. BEGIN { # Work-around for bug #479711 in perl
  3. $ENV{PERL_DL_NONLAZY} = 1;
  4. }
  5. use strict;
  6. use warnings;
  7. use POSIX;
  8. use POSIX qw(:errno_h :signal_h);
  9. use Dpkg;
  10. use Dpkg::Gettext;
  11. textdomain("dpkg");
  12. my $verbose = 1;
  13. my $doforce = 0;
  14. my $doupdate = 0;
  15. my $mode = "";
  16. my %owner;
  17. my %group;
  18. my %mode;
  19. sub version {
  20. printf _g("Debian %s version %s.\n"), $progname, $version;
  21. printf _g("
  22. Copyright (C) 2000 Wichert Akkerman.");
  23. printf _g("
  24. This is free software; see the GNU General Public Licence version 2 or
  25. later for copying conditions. There is NO warranty.
  26. ");
  27. }
  28. sub usage {
  29. printf _g(
  30. "Usage: %s [<option> ...] <command>
  31. Commands:
  32. --add <owner> <group> <mode> <file>
  33. add a new entry into the database.
  34. --remove <file> remove file from the database.
  35. --list [<glob-pattern>] list current overrides in the database.
  36. Options:
  37. --admindir <directory> set the directory with the statoverride file.
  38. --update immediately update file permissions.
  39. --force force an action even if a sanity check fails.
  40. --quiet quiet operation, minimal output.
  41. --help show this help message.
  42. --version show the version.
  43. "), $progname;
  44. }
  45. sub CheckModeConflict {
  46. return unless $mode;
  47. badusage(sprintf(_g("two commands specified: %s and --%s"), $_, $mode));
  48. }
  49. while (@ARGV) {
  50. $_=shift(@ARGV);
  51. last if m/^--$/;
  52. if (!m/^-/) {
  53. unshift(@ARGV,$_); last;
  54. } elsif (m/^--help$/) {
  55. usage();
  56. exit(0);
  57. } elsif (m/^--version$/) {
  58. version();
  59. exit(0);
  60. } elsif (m/^--update$/) {
  61. $doupdate=1;
  62. } elsif (m/^--quiet$/) {
  63. $verbose=0;
  64. } elsif (m/^--force$/) {
  65. $doforce=1;
  66. } elsif (m/^--admindir$/) {
  67. @ARGV || badusage(sprintf(_g("--%s needs a <directory> argument"), "admindir"));
  68. $admindir= shift(@ARGV);
  69. } elsif (m/^--add$/) {
  70. CheckModeConflict();
  71. $mode= 'add';
  72. } elsif (m/^--remove$/) {
  73. CheckModeConflict();
  74. $mode= 'remove';
  75. } elsif (m/^--list$/) {
  76. CheckModeConflict();
  77. $mode= 'list';
  78. } else {
  79. badusage(sprintf(_g("unknown option \`%s'"), $_));
  80. }
  81. }
  82. my $dowrite = 0;
  83. my $exitcode = 0;
  84. badusage(_g("no mode specified")) unless $mode;
  85. ReadOverrides();
  86. if ($mode eq "add") {
  87. @ARGV == 4 || badusage(_g("--add needs four arguments"));
  88. my $user = $ARGV[0];
  89. my $uid = 0;
  90. my $gid = 0;
  91. if ($user =~ m/^#([0-9]+)$/) {
  92. $uid=$1;
  93. badusage(sprintf(_g("illegal user %s"), $user)) if ($uid < 0);
  94. } else {
  95. my ($name, $pw);
  96. (($name, $pw, $uid) = getpwnam($user)) ||
  97. badusage(sprintf(_g("non-existing user %s"), $user));
  98. }
  99. my $group = $ARGV[1];
  100. if ($group =~ m/^#([0-9]+)$/) {
  101. $gid=$1;
  102. badusage(sprintf(_g("illegal group %s"), $group)) if ($gid < 0);
  103. } else {
  104. my ($name, $pw);
  105. (($name, $pw, $gid) = getgrnam($group)) ||
  106. badusage(sprintf(_g("non-existing group %s"), $group));
  107. }
  108. my $mode = $ARGV[2];
  109. (($mode < 0) or (oct($mode) > 07777) or ($mode !~ m/\d+/)) &&
  110. badusage(sprintf(_g("illegal mode %s"), $mode));
  111. my $file = $ARGV[3];
  112. $file =~ m/\n/ && badusage(_g("file may not contain newlines"));
  113. $file =~ s,/+$,, && print STDERR _g("stripping trailing /")."\n";
  114. if (defined $owner{$file}) {
  115. printf STDERR _g("An override for \"%s\" already exists, "), $file;
  116. if ($doforce) {
  117. print STDERR _g("but --force specified so will be ignored.")."\n";
  118. } else {
  119. print STDERR _g("aborting")."\n";
  120. exit(3);
  121. }
  122. }
  123. $owner{$file}=$user;
  124. $group{$file}=$group;
  125. $mode{$file}=$mode;
  126. $dowrite=1;
  127. if ($doupdate) {
  128. if (not -e $file) {
  129. printf STDERR _g("warning: --update given but %s does not exist")."\n", $file;
  130. } else {
  131. chown ($uid,$gid,$file) || warn sprintf(_g("failed to chown %s: %s"), $file, $!)."\n";
  132. chmod (oct($mode),$file) || warn sprintf(_g("failed to chmod %s: %s"), $file, $!)."\n";
  133. }
  134. }
  135. } elsif ($mode eq "remove") {
  136. @ARGV == 1 || badusage(sprintf(_g("--%s needs a single argument"), "remove"));
  137. my $file = $ARGV[0];
  138. $file =~ s,/+$,, && print STDERR _g("stripping trailing /")."\n";
  139. if (not defined $owner{$file}) {
  140. print STDERR _g("No override present.")."\n";
  141. exit(0) if ($doforce);
  142. exit(2);
  143. }
  144. delete $owner{$file};
  145. delete $group{$file};
  146. delete $mode{$file};
  147. $dowrite=1;
  148. print(STDERR _g("warning: --update is useless for --remove")."\n") if ($doupdate);
  149. } elsif ($mode eq "list") {
  150. my (@list, @ilist);
  151. @ilist= @ARGV ? @ARGV : ('*');
  152. while (defined($_=shift(@ilist))) {
  153. s/\W/\\$&/g;
  154. s/\\\?/./g;
  155. s/\\\*/.*/g;
  156. s,/+$,, && print STDERR _g("stripping trailing /")."\n";
  157. push(@list,"^$_\$");
  158. }
  159. my $pattern = join('|', @list);
  160. $exitcode=1;
  161. for my $file (keys %owner) {
  162. next unless ($file =~ m/$pattern/o);
  163. $exitcode=0;
  164. print "$owner{$file} $group{$file} $mode{$file} $file\n";
  165. }
  166. }
  167. WriteOverrides() if ($dowrite);
  168. exit($exitcode);
  169. sub ReadOverrides {
  170. open(SO, "$admindir/statoverride") ||
  171. quit(sprintf(_g("cannot open statoverride: %s"), $!));
  172. while (<SO>) {
  173. my ($owner,$group,$mode,$file);
  174. chomp;
  175. ($owner,$group,$mode,$file)=split(' ', $_, 4);
  176. die sprintf(_g("Multiple overrides for \"%s\", aborting"), $file)
  177. if defined $owner{$file};
  178. $owner{$file}=$owner;
  179. $group{$file}=$group;
  180. $mode{$file}=$mode;
  181. }
  182. close(SO);
  183. }
  184. sub WriteOverrides {
  185. my ($file);
  186. open(SO, ">$admindir/statoverride-new") ||
  187. quit(sprintf(_g("cannot open new statoverride file: %s"), $!));
  188. foreach $file (keys %owner) {
  189. print SO "$owner{$file} $group{$file} $mode{$file} $file\n";
  190. }
  191. close(SO);
  192. chmod(0644, "$admindir/statoverride-new");
  193. unlink("$admindir/statoverride-old") ||
  194. $! == ENOENT || quit(sprintf(_g("error removing statoverride-old: %s"), $!));
  195. link("$admindir/statoverride","$admindir/statoverride-old") ||
  196. $! == ENOENT || quit(sprintf(_g("error creating new statoverride-old: %s"), $!));
  197. rename("$admindir/statoverride-new","$admindir/statoverride")
  198. || quit(sprintf(_g("error installing new statoverride: %s"), $!));
  199. }
  200. sub quit
  201. {
  202. printf STDERR "%s: %s\n", $0, "@_";
  203. exit(2);
  204. }
  205. sub badusage
  206. {
  207. printf STDERR "%s: %s\n\n", $0, "@_";
  208. usage();
  209. exit(2);
  210. }
  211. # vi: ts=8 sw=8 ai si cindent