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.
10 # checkperms dkg /home/dkg/.monkeysphere/authorized_user_ids
12 # return values: zero if we believe the file and path can only be
13 # modified by the user. non-zero otherwise.
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.
20 # Daniel Kahn Gillmor <dkg@fifthhorseman.net>
22 # Started on: 2009-07-31 11:10:16-0400
24 # License: GPL v3 or later
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)
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";
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";
46 # FIXME: check and compare the log level
47 if ($ENV{LOG_LEVEL} eq 'DEBUG') {
49 my $out = sprintf($format, @_);
51 $out =~ s/^/$ENV{LOG_PREFIX}/ ;
53 printf STDERR "%s", $out;
57 ## return undef if permissions are OK. otherwise return an error string
62 # if we can't even stat the path, the permissions are not ok:
63 my $stat = lstat($path) or return "cannot stat '$path'";
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);
69 $stat = lstat($path) or return "cannot stat '$path'";
71 mslog('DEBUG', "checking '%s'\n", $path);
73 if (($stat->uid != $user->uid) &&
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);
79 if ($stat->mode & S_IWGRP) {
80 return sprintf("improper group writability on '%s'", $path);
83 if ($stat->mode & S_IWOTH) {
84 return sprintf("improper other writability on '%s'", $path);
87 # see the rationalization in secure_filename() in auth.c in the
88 # OpenSSH sources for an explanation of this bailout (see also
90 if ($path eq $user->dir) {
91 mslog('DEBUG', "stopping at the %s's home directory '%s'\n", $user->name, $path);
95 my $nextlevel = dirname($path);
96 if ($path eq $nextlevel) { # we bottom out at the root (/ in UNIX)
99 return permissions_ok($user, $nextlevel);
102 my $err = permissions_ok($pw, $path);
105 printf(STDERR "%s%s\n", $ENV{LOG_PREFIX}, $err);