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