renaming m-h update_gpg_pub_file to update_pgp_pub_file
[monkeysphere.git] / src / share / checkperms
index 9247832e9840d5a623e813d4acd51274c5e59ddb..aa67d964c1630e849b2aae39ae7d2497a6beec94 100755 (executable)
@@ -34,16 +34,23 @@ use File::Basename; # for dirname (in perl-modules)
 my $username = shift;
 my $path = shift;
 
-defined($username) or die "You must pass a username and an absolute path.";
-defined($path) or die "You must pass a username and an absolute path.";
+defined($username) or die "You must pass a username and an absolute path.\n";
+defined($path) or die "You must pass a username and an absolute path.\n";
 
-my $pw = getpwnam($username) or die "no such user $username";
-$path =~ m#^/# or die "path was not absolute (did not start with /)";
+my $pw = getpwnam($username) or die "no such user $username\n";
+$path =~ m#^/# or die "path was not absolute (did not start with /)\n";
 
-sub debug {
-  if ($ENV{MONKEYSPHERE_LOG_LEVEL} eq 'DEBUG') {
-    # FIXME: prefix with ms: 
-    printf STDERR @_;
+sub mslog {
+  my $level = shift;
+
+  # FIXME: check and compare the log level
+  if ($ENV{LOG_LEVEL} eq 'DEBUG') {
+    my $format = shift;
+    my $out = sprintf($format, @_);
+
+    $out =~ s/^/$ENV{LOG_PREFIX}/ ;
+
+    printf STDERR "%s", $out;
   }
 }
 
@@ -53,32 +60,36 @@ sub permissions_ok {
   my $path = shift;
 
   # if we can't even stat the path, the permissions are not ok:
-  my $stat = lstat($path) or return "cannot stat '$path'\n";
+  my $stat = lstat($path) or return "cannot stat '$path'";
 
   while (S_ISLNK($stat->mode)) {
-    my $newpath = realpath($path) or return "cannot trace symlink '$path'\n";
-    debug("tracing link %s to %s\n", $path, $newpath);
+    my $newpath = realpath($path) or return "cannot trace symlink '$path'";
+    mslog('DEBUG', "tracing link %s to %s\n", $path, $newpath);
     $path = $newpath;
-    $stat = lstat($path) or return "cannot stat '$path'\n";
+    $stat = lstat($path) or return "cannot stat '$path'";
   }
-  debug("checking '%s'\n", $path);
+  mslog('DEBUG', "checking '%s'\n", $path);
 
   if (($stat->uid != $user->uid) &&
       ($stat->uid != 0)) {
-    return sprintf("improper ownership on '%s':\nowner ID %d is neither %s (ID %d) nor the superuser\n", 
+    return sprintf("improper ownership on '%s': owner ID %d is neither %s (ID %d) nor the superuser",
                   $path, $stat->uid, $user->name, $user->uid);
   }
 
-  if (S_IWGRP & $stat->mode) {
-    return sprintf("improper group writability on '%s'\n", $path);
+  if ($stat->mode & S_IWGRP) {
+    return sprintf("improper group writability on '%s'", $path);
   }
 
-  if (S_IWGRP & $stat->mode) {
-    return sprintf("improper group writability on '%s'\n", $path);
+  if ($stat->mode & S_IWOTH) {
+    return sprintf("improper other writability on '%s'", $path);
   }
 
-  if (S_IWOTH & $stat->mode) {
-    return sprintf("improper other writability on '%s'\n", $path);
+  # see the rationalization in secure_filename() in auth.c in the
+  # OpenSSH sources for an explanation of this bailout (see also
+  # monkeysphere #675):
+  if ($path eq $user->dir) {
+    mslog('DEBUG', "stopping at the %s's home directory '%s'\n", $user->name, $path);
+    return undef;
   }
 
   my $nextlevel = dirname($path);
@@ -91,8 +102,7 @@ sub permissions_ok {
 my $err = permissions_ok($pw, $path);
 
 if (defined($err)) {
-  $err =~ s/^/ms: /;
-  printf(STDERR $err);
+  printf(STDERR "%s%s\n", $ENV{LOG_PREFIX}, $err);
 
   exit(1);
 } else {