src/share/checkperms

   1 #!/usr/bin/perl -T
   2
   3 # checkperms: ensure as best we can that a given file can only be
   4 # modified by the given user (or the superuser, naturally).  This
   5 # means checking file ownership and permissions all the way back to
   6 # the root directory.  Pass the file by its absolute path.
   7
   8 # example invocation:
   9
  10 # checkperms dkg /home/dkg/.monkeysphere/authorized_user_ids
  11
  12 # return values: zero if we believe the file and path can only be
  13 # modified by the user.  non-zero otherwise.
  14
  15 # see StrictModes in sshd_config(5) (and its implementation in
  16 # OpenSSH's secure_filename() in auth.c) for the initial
  17 # inspiration/rationale for this code.
  18
  19 # Author:
  20 #  Daniel Kahn Gillmor <dkg@fifthhorseman.net>
  21
  22 # Started on: 2009-07-31 11:10:16-0400
  23
  24 # License: GPL v3 or later
  25
  26 use strict;
  27
  28 use Cwd qw(realpath); # found in debian in perl-base
  29 use File::stat; # found in debian in perl-modules
  30 use User::pwent; # found in debian in perl-modules
  31 use Fcntl qw(:mode); # for S_IS* functions (in perl-base)
  32 use File::Basename; # for dirname (in perl-modules)
  33
  34 my $username = shift;
  35 my $path = shift;
  36
  37 defined($username) or die "You must pass a username and an absolute path.\n";
  38 defined($path) or die "You must pass a username and an absolute path.\n";
  39
  40 my $pw = getpwnam($username) or die "no such user $username\n";
  41 $path =~ m#^/# or die "path was not absolute (did not start with /)\n";
  42
  43 sub mslog {
  44   my $level = shift;
  45
  46   # FIXME: check and compare the log level
  47   if ($ENV{LOG_LEVEL} eq 'DEBUG') {
  48     my $format = shift;
  49     my $out = sprintf($format, @_);
  50
  51     $out =~ s/^/$ENV{LOG_PREFIX}/ ;
  52
  53     printf STDERR "%s", $out;
  54   }
  55 }
  56
  57 ## return undef if permissions are OK.  otherwise return an error string
  58 sub permissions_ok {
  59   my $user = shift;
  60   my $path = shift;
  61
  62   # if we can't even stat the path, the permissions are not ok:
  63   my $stat = lstat($path) or return "cannot stat '$path'";
  64
  65   while (S_ISLNK($stat->mode)) {
  66     my $newpath = realpath($path) or return "cannot trace symlink '$path'";
  67     mslog('DEBUG', "tracing link %s to %s\n", $path, $newpath);
  68     $path = $newpath;
  69     $stat = lstat($path) or return "cannot stat '$path'";
  70   }
  71   mslog('DEBUG', "checking '%s'\n", $path);
  72
  73   if (($stat->uid != $user->uid) &&
  74       ($stat->uid != 0)) {
  75     return sprintf("improper ownership on '%s': owner ID %d is neither %s (ID %d) nor the superuser",
  76                    $path, $stat->uid, $user->name, $user->uid);
  77   }
  78
  79   if ($stat->mode & S_IWGRP) {
  80     return sprintf("improper group writability on '%s'", $path);
  81   }
  82
  83   if ($stat->mode & S_IWOTH) {
  84     return sprintf("improper other writability on '%s'", $path);
  85   }
  86
  87   # see the rationalization in secure_filename() in auth.c in the
  88   # OpenSSH sources for an explanation of this bailout (see also
  89   # monkeysphere #675):
  90   if ($path eq $user->dir) {
  91     mslog('DEBUG', "stopping at the %s's home directory '%s'\n", $user->name, $path);
  92     return undef;
  93   }
  94
  95   my $nextlevel = dirname($path);
  96   if ($path eq $nextlevel) { # we bottom out at the root (/ in UNIX)
  97     return undef;
  98   }
  99   return permissions_ok($user, $nextlevel);
 100 }
 101
 102 my $err = permissions_ok($pw, $path);
 103
 104 if (defined($err)) {
 105   printf(STDERR "%s%s\n", $ENV{LOG_PREFIX}, $err);
 106
 107   exit(1);
 108 } else {
 109   exit(0);
 110 }
 111