source: server/common/oursrc/accountadm/admof.in @ 494

#!/usr/bin/perl
use strict;

# admof
# Copyright (C) 2006  Jeff Arnold <jbarnold@mit.edu>
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 2
# of the License, or (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA
#
# See /COPYRIGHT in this repository for more information.

$ENV{PATH} = '';

my $targetuser;
unless(($targetuser) = ($ARGV[0] =~ /^([\w._-]+)$/)) {
  error("Invalid locker name: <$ARGV[0]>.");
}
my $curuser;
unless(($curuser) = ($ARGV[1] =~ /^([\w._\/-]+)\@ATHENA\.MIT\.EDU$/)) {
  error("An internal error has occurred.\nContact scripts\@mit.edu for assistance.");
}

($curuser) =~ s|/|.|; # Replace first instance of a / only; pts membership prints foo/root as foo.root

if (($curuser) =~ m|/|) { # There were two /'s in their name. What?
  error("An internal error has occurred.\nContact scripts\@mit.edu for assistance.");
}

my (undef, undef, $uid, undef, undef, undef, undef, $home, undef, undef)
  = getpwnam $targetuser;
if(defined $uid) {
  error() if ($uid <= 1000);
} else {
  $home = "/mit/$targetuser";
}

my $cell;
unless(open WHICHCELL, '-|') {
  close STDERR;
  exec '@fs_path@', 'whichcell', '-path', $home;
  die;
}

unless(($cell) = (<WHICHCELL> =~ /^File \Q$home\E lives in cell '(.*)'$/)) {
  error("Cannot find locker <$targetuser>.");
}
close WHICHCELL;

open LISTACL, '-|', '@fs_path@', 'listacl', '-path', $home;

#Access list for . is
#Normal rights:
#  system:scripts-root rlidwka
#  system:anyuser rl

unless(<LISTACL> eq "Access list for $home is\n" &&
       <LISTACL> eq "Normal rights:\n") {
  error("Cannot find locker <$targetuser>.");
}

if($ARGV[2] && !defined $uid) {
  error("Locker <$targetuser> does not have a scripts.mit.edu account.");
}

my @targetacl = <LISTACL>;
push(@targetacl, "  system:scripts-root rlidwka");

close LISTACL;

foreach(@targetacl) {
  last unless /^  /;
  my ($name) = /^  ([\w:_.-]+) \w*a\w*$/ or next;
  if($name eq $curuser) { success(); }
  elsif($name =~ /:/) {
    unless(open MEMBERSHIP, '-|') {
      close STDERR;
      exec '@pts_path@', 'membership', '-nameorid', $name, '-cell', $cell;
      die;
    }

#Members of system:scripts-root (id: -56104) are:
#  hartmans
#  jbarnold
#  presbrey
#  tabbott
#  hartmans.root

    next unless(<MEMBERSHIP> =~ /^Members of \Q$name\E \(id: \S+\) are:$/);
    while(<MEMBERSHIP>) {
      success() if($_ eq "  $curuser\n");
    }
    close MEMBERSHIP;
  }
}

print <<END;

ERROR:
It appears as though you are not an administrator of locker <$targetuser>.
In order to be able to su to <$targetuser>, you must have full AFS access
to the root directory of locker <$targetuser>.  Try running the command
fs sa /mit/$targetuser $curuser all
on Athena in order to explicitly grant yourself full AFS access.
Contact scripts\@mit.edu if you are unable to solve the problem.

END

exit(1);

sub error {
  print "\nERROR:\n$_[0]\n\n";
  exit(1);
}

sub success {
  print "yes";
  exit(33);
}