#!/usr/bin/perl
#
# addftpuser: a utility to create an anonymous FTP account
#
# Copyright (C) 1995 Peter Tobias <tobias@et-inf.fho-emden.de>
# ... changed some parts Heiko Schlittermann <heiko@lotte.sax.de>
#
#    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., 675 Mass Ave, Cambridge, MA 02139, USA.
#

# only use the following line while programming (BTW, it doesn't work :)
#use strict;

# The rmftpuser functionality, by Josip Rodin `99.
if ( $0 =~ m/rmftpuser$/i ) {
 die "You must be root to run this script.\n" if ($> != 0);

 print "Are you sure you want to remove the anonymous FTP user? [Y/n] ";
  if (<STDIN> =~ /^n/i) {
    print "Exiting.\n";
    exit(0);
  }

 my $itshomedir = (getpwnam("ftp"))[7] or die "It doesn't exist, silly!\n";

 system ("userdel", "ftp") == 0 or die "Removal failed!\n";
 print "The anonymous FTP user has been successfully removed.\n";

 print "Do you want to remove the anonymous FTP directory, too? [Y/n] ";
  if (<STDIN> =~ /^n/i) {
   print "Its home directory, $itshomedir, has been left intact.\n";
   exit(0);
  }

 system ("rm", "-rf", $itshomedir) == 0 or die "Removal failed!\n";
 print "The anonymous FTP directory has also been removed.\n";

 exit(0);
}

my $version = '$Revision: 1.2 $';

my $uid = 10;                        # start searching for a free uid at uid 10
my $default_home = "/home/ftp";      # the default FTP home directory
my $default_dir_mode = 0755;         # the default directory permissions
my $group = "staff";                 # the default group for the FTP hierarchy
my $pathmsg = "/etc/wu-ftpd/pathmsg";   # the pathmsg file
my $welcomemsg = "/etc/wu-ftpd/welcome.msg"; # the welcome.msg file
my $ftpusers = "/etc/wu-ftpd/ftpusers"; # the ftpusers file
my @bins = qw(/bin/ls /bin/gzip /bin/tar);
#my @bins = qw(/bin/gzip /bin/tar);
if ( -e "/usr/bin/zip" ) {
	my @optbins = qw(/usr/bin/zip);
} else {
	my @optbins = ();
}

my $updatebin = 0;
my $configure = 0;

my ($aout, @dirs, $done, $elf, @ftpfiles, $gid, $have_passwd_entry, $home, $want_incoming);

# strip directory from the filename
$0 =~ s#.*/##;

# cleanup $version
$version =~ s/\S+: (\S+) \$/$1/;

# set OUTPUT_AUTOFLUSH
$| = 1;

# don't change the permissions
umask(000);

while ($ARGV[0] =~ m/^-/) {
  $_ = shift(@ARGV);
  if (/--help$/) {
    &usage;
  } elsif (/--version$/) {
    print "$0 $version\n";
    exit(0);
  } elsif (/--check-binaries$/) {
    &checkbin;
  } elsif (/--configure$/) {
    $configure = 1;
  } elsif (/--update-binaries$/) {
    $updatebin = 1;
  } elsif (/--group$/) {
    $group = shift(@ARGV);
    die "$0: Option group requires an argument\n" unless ($group);
  } else {
    print "$0: Unknown option: $_\n";
    print "$0: Try `$0 --help' for more information.\n";
    exit(10);
  }
}

if (@ARGV) {
  print "$0: Unknown argument: @ARGV\n";
  print "$0: Try `$0 --help' for more information.\n";
  exit(10);
}

# only root may set up an anonymous FTP account
die "You must be root to run this script.\n" if ($> != 0);

# check if the user "ftp" already exists
setpwent;
if ($home = (getpwnam("ftp"))[7]) {
   if (-d $home) {
     exit(0) unless $updatebin;
   } else {
     print "\nYou already have an anonymous FTP account, but the FTP home\n";
     print "directory [$home] does not exist!\n\nDo you want to create it? [y] ";

     if (<STDIN> =~ /^n/i) {
       exit(0);
     }
   }
   $have_passwd_entry = 1;
}
endpwent;

if (not $have_passwd_entry) {

  if ($configure) {
  print "\nDo you want to set up or update an anonymous FTP account now? [n] ";
  if (<STDIN> =~ /^[^y]/i) {
    print "\nYou can add an anonymous FTP account later using /usr/sbin/addftpuser\n";
    print "(see  addftpuser --help  for more information).\n";
    exit(0);
  }
  }

  # we need the name of the home directory
  while(1) {
    $home = "";
    print "\nEnter the name of the FTP home directory: [$default_home] ";
    chop($home = <STDIN>);
    $home =~ s/\s+//g;         # remove spaces ...
    $home =~ s#//+#/#g;        # we don't want things like // in $home
    $home =~ s#/$##;           # remove trailing slash if it exists

    $home = $default_home unless ($home);

    if (! ($home =~ m#^/#)) {
      print "\nYou have to use an absolute path for the home directory.\n";
      print "In other words, it must begin with a slash.\n";
      next;
    }

    if (-d $home) {
      print "\n$home does already exist, should I use it? [n] ";
        next if (<STDIN> =~ /^[^y]/i);
    }
    last;
  }

  print "\nDo you want to create a directory for user uploads? [n] ";
  if (<STDIN> =~ /^[^y]/i) {
    $want_incoming = 0;
  } else {
    $want_incoming = 1;
    print "\nPlease look at /etc/wu-ftpd/ftpaccess and its manual page for\n";
    print "further information on how to make /pub/incoming more secure.\n";
  }

  if (getgrnam('ftp')) { @_ = ('adduser', '--system', 
	  	'--home', $home, '--ingroup', 'ftp', 'ftp'); }
  else { @_ = ('adduser', '--system', 
	  	'--home', $home, '--group', 'ftp'); }

  system(@_) and die("$0: failed system command ``$_''\n");
}

# don't let the user interrupt us
&ignore_signals;

# create the FTP home directory and its subdirectories
@dirs = split(/\//, $home);
shift(@dirs);    # remove the first element (it's empty because of the
                 # leading slash in $home)
pop(@dirs);      # remove the last element (we will create it later)
$done = "";

while(@dirs) {
   my $element = shift(@dirs);
   unless(-d "$done/$element") {
     mkdir("$done/$element", $default_dir_mode);
   }
   $done = "$done/$element";
}

# if the directory exist fix the permissions otherwise create it
chmod(0555, "$home") || mkdir("$home", 0555) ||
	die "$0: can't mkdir $home: $!\n";
chmod(0111, "$home/bin") || mkdir("$home/bin", 0111) ||
	die "$0: can't mkdir $home/bin: $!\n";
chmod(0111, "$home/lib") || mkdir("$home/lib", 0111) ||
	die "$0: can't mkdir $home/lib: $!\n";
chmod(0111, "$home/etc") || mkdir("$home/etc", 0111) ||
	die "$0: can't mkdir $home/etc: $!\n";
chmod(0555, "$home/pub") || mkdir("$home/pub", 0555) ||
	warn "$0: warning: can't mkdir $home/pub: $!\n";
chown(0, 0, "$home", "$home/bin", "$home/lib", "$home/etc", "$home/pub");

if ($want_incoming and not $updatebin) {
  chmod(0753, "$home/pub/incoming") || mkdir("$home/pub/incoming", 0753) ||
	warn "$0: warning: can't mkdir $home/pub/incoming: $!\n";
  chown(0, 0, "$home/pub/incoming");
}
# copy the wanted binaries
foreach (@bins) {
	my ($src, $dst);
  	$src = $_; s/^.*\///; $dst = "$home/bin/$_";
	&copy_move($src, $dst) || die "$0: Failed to copy $src to $dst: $?\n";
}

# copy the optional binaries
foreach (@optbins) {
	my ($src, $dst);

	-f or next;

	$src = $_; s/^.*\///; $dst = "$home/bin/$_";

	&copy_move($src, $dst) || warn "$0: Failed to copy $src to $dst: $? (ignored)\n";
}

# library check
opendir(FTPBIN, "$home/bin");
  @ftpfiles = readdir(FTPBIN);
closedir(FTPBIN);

($aout, $elf) = &filetype("$home/bin", @ftpfiles);

if($elf) {

	foreach ((getlibs(<$home/bin/*>))) {
		my ($src, $dst);
		$src = $_; s/^.*\///; $dst = "$home/lib/$_";
		&copy_move($src, $dst) || die "$0: Failed to copy $src to $dst: $?\n";
	}

	print "\nAnonymous FTP users will only see UID and GID numbers, instead of\n";
	print "names, because the libnss_files.so library hasn't been installed.\n";
	print "\nIt is not installed by default, since there is no easy way to find\n";
	print "out what version we need to install.\n";
	print "\nIf you want to install it manually, it should be placed in $home/lib\n";
	print "owned by root, and with permissions of 444 (r--r--r--)\n";

#-    my($libc, $libc_link, $dir);
#-    $libc_link=&findlib(5);
#-    if ($libc_link) {
#-        $libc=readlink($libc_link) || die "$0: broken symbolic link: $!";
#-        ($dir = $libc_link) =~ s#[^/]+$## unless($libc =~ m#/#);
#-        system("cp /lib/ld-linux.so.1 $home/lib") && die "$0: can't copy ld-linux.so.1: $!\n";
#-        system("cp $dir$libc $home/lib") && die "$0: can't copy $dir$libc: $!\n";
#-        chmod(0555, "$home/lib/ld-linux.so.1", "$dir$libc");
#-        if ($libc =~ /\.old$/) {
#-            $libc =~ s/\.old$//;
#-            system("mv $home/lib/$libc.old $home/lib/$libc");
#-        }
#-        symlink("$libc", "$home/lib/libc.so.5");
#-#        system("mknod -m 0666 $home/dev/zero c 1 5") && die "$0: mknod failed: $!\n";
#-    } else {
#-        print "$0: ELF binaries found but libc.so.5 not available\n";
#-    }
} else {
    $_ = readlink("$home/lib/libc.so.5");
    unlink("$home/lib/$_");
    unlink("$home/lib/ld-linux.so.1");
    unlink("$home/lib/libc.so.5");
}
if($aout) {
    my($libc, $libc_link, $dir);
    $libc_link=&findlib(4);
    if ($libc_link) {
        $libc = readlink($libc_link) || die "$0: broken symbolic link: $!";
        ($dir = $libc_link) =~ s#[^/]+$## unless($libc =~ m#/#);
        system("cp /lib/ld.so $home/lib") && die "$0: can't copy ld.so: $!\n";
        system("cp $dir$libc $home/lib") && die "$0: can't copy $dir$libc: $!\n";
        chmod(0555, "$home/lib/ld.so", "$dir$libc");
        if ($libc =~ /\.old$/) {
            $libc =~ s/\.old$//;
            system("mv $home/lib/$libc.old $home/lib/$libc");
        }
        symlink("$libc", "$home/lib/libc.so.4");
    } else {
        print "$0: a.out binaries found but libc.so.4 not available\n";
    }
} else {
    $_ = readlink("$home/lib/libc.so.4");
    unlink("$home/lib/$_");
    unlink("$home/lib/ld.so");
    unlink("$home/lib/libc.so.4");
}

# copy the pathmsg file (if available)
system("cp $pathmsg $home/etc/pathmsg") unless (-f "$home/etc/pathmsg");

# copy the welcome.msg file (if available)
system("cp $welcomemsg $home/welcome.msg") unless (-f "$home/welcome.msg");

# create the passwd file for the new anonymous FTP hierarchy
if ( ! -f "$home/etc/passwd") {
  open(FPASSWD,">$home/etc/passwd");
    print FPASSWD "root:*:0:0:root::\n";
    print FPASSWD "ftp:*:$uid:$gid:Anonymous FTP::\n";
  close(FPASSWD);
}

# create the group file for the new anonymous FTP hierarchy
if ( ! -f "$home/etc/group") {
  open(FGROUP,">$home/etc/group");
    print FGROUP "root\:\:0:\n";
    print FGROUP "$group\:\:$gid:\n";
  close(FGROUP);
}

# fix a few permissions
chmod 0444, <$home/etc/*>;
chmod 0111, <$home/bin/*>;
chmod 0444, <$home/lib/*>;
chmod 0555, <$home/lib/ld-linux*>;

# check ftpusers
if ( -f $ftpusers ) {
	$found_ftpuser = 0;
	open (FFTPUSERS, "<$ftpusers");
  	while (<FFTPUSERS>) {
		/^(ftp|anonymous)$/	&&	do { 
			print STDOUT <<EOF;
Your $ftpusers file contains entries for ftp and/or anonymous, the anonymous
ftp usernames.

To enable access to anonymous ftp, you will need to disable these entries.
EOF
			print "Do you want these disabled automatically? [Y/n]";
			$found_ftpuser = 1;
		  	last unless <STDIN> =~ /^n/i;

			&restore_signals;
			exit 0;
		};
	}
	if ($found_ftpuser == 1) {
		seek FFTPUSERS, 0, 0;
		my @ftpusers = <FFTPUSERS>;
		my $tmpfile = `tempfile`;
		chomp $tmpfile;

		open (FTMPFILE, ">$tmpfile");
		for (@ftpusers) {
			/^(ftp|anonymous)$/	&& do { print FTMPFILE '#',$_; next; };
	
			print FTMPFILE;
		}	
		close FFTPUSERS;
		close FTMPFILE;

		@cmd = ("mv", $tmpfile, $ftpusers);
		system(@cmd) and die "can't overwrite $ftpusers";
	}
}

# restore the default signal action. Not really necessary ...
&restore_signals;

exit 0;

############################################################################

sub usage {
  print STDOUT <<EOF;
Usage: $0 [OPTION]

--group group         use this group for the anonymous FTP account
--check-binaries      check whether the binaries and libraries of the
                      FTP hierarchy should be updated or not (an exit
                      status of 0 means no update required)
--update-binaries     update binaries and libraries of the FTP hierarchy
--help                display this help and exit
--version             output version information and exit
EOF
  exit(0);
}

sub ignore_signals {
  $SIG{'HUP'} = 'IGNORE';
  $SIG{'INT'} = 'IGNORE';
  $SIG{'QUIT'} = 'IGNORE';
  $SIG{'TERM'} = 'IGNORE';
}

sub restore_signals {
  $SIG{'HUP'} = 'DEFAULT';
  $SIG{'INT'} = 'DEFAULT';
  $SIG{'QUIT'} = 'DEFAULT';
  $SIG{'TERM'} = 'DEFAULT';
}

sub findlib {
    my $v = shift;
    my @ld;
    open(LD, "/etc/ld.so.conf");
        chomp(@ld=<LD>);
    close(LD);
    unshift(@ld, ("/lib", "/usr/lib"));

    while(@ld) {
        $_ = shift(@ld);
        return("$_/libc.so.$v") if (-f "$_/libc.so.$v");
    }
    return(0);
}

sub filetype {
    # ($n_aout, $n_elf) = &filetype($base_directory, @filenames_without_path);
    my($dir, @files) = @_;
    my($n_aout, $n_elf, $string);
    while(@files) {
        $_ = shift(@files);
        next if ($_ eq "." or $_ eq "..");
        open(CH, "$dir/$_");
        read(CH, $string, 4);
        if ($string =~ m/\177ELF/) {
           ++$n_elf;
        } elsif ($string =~ m/..\144./) {
           ++$n_aout;
        }
        close(CH);
        undef($string);
    }
    return($n_aout, $n_elf);
}

sub getlibs {
	my $file;
	my %libs;
	foreach $file (@_) {
		foreach (`ldd $file`) { chomp;
			my $lib;
			/\s=>\s/ or next;
			($lib) = /.*=>\s(.*?)\s/;
			$libs{$lib} = 1;
		}
	}
	# Hack: although it does not show up with ldd,
	# libnss_files.so is required for file owner/groups to
	# displayed for anonymous FTP.
	#
	# Commented out, since there's no easy way to find out what version
	# of the library we need.
	#  -- Chris Butler <chrisb@sandy.force9.co.uk>
	#
	# my $nnsv;
	# for($nssv=1;$nssv<10;$nssv++) {
	# 	if ( -f "/lib/libnss_files.so.$nssv") {
	#		$libs{"/lib/libnss_files.so.$nssv"} = 1;
	#	}
	# }
	return sort keys %libs;
}

sub checkbin {
    # exit with error level 1 if the file formats of /bin/<something>
    # and ~ftp/bin/<something> are different.
    my($ftphome, $binls_elf, $ftpls_elf);
	my @dynlinker = ();
	my @errors;
    setpwent;
    if ($ftphome = (getpwnam("ftp"))[7]) {
		if (-d $ftphome) {

			@errors = ();
			foreach (@bins) {
				my ($src, $dst);
				$src = $_; /^.*\/(.*)/; $dst = "$ftphome/bin/$1";
				-r $dst or push @errors, "ERROR: Can't find $dst.\n";
			}
			@errors and $! = 1, die @errors;

			@errors = ();
			foreach (@bins, @optbins) {
				my ($src, $dst);
				my ($srcmd5, $dstmd5);
				$src = $_; /^.*\/(.*)/; $dst = "$ftphome/bin/$1";

			   $srcmd5 = (split /\s/, `md5sum $src`, 2)[0];
			   $dstmd5 = (split /\s/, `md5sum $dst`, 2)[0];

			   ($srcmd5 eq $dstmd5) and next;
			   push @errors, "$0: ERROR: md5 check failed for $dst\n";
			}
			@errors and $! = 1, die @errors;

			opendir(D, "$ftphome/bin") or die("$0: Can't read $ftphome/bin: $!\n"); 
			@_ = readdir(D); closedir(D);

			@errors = ();
			foreach (getlibs(<$ftphome/bin/*>)) {
				/ld-linux/ and push @dynlinker, "$ftphome$_";
				-f "$ftphome$_" or push @errors, "$0: Warning: $ftphome$_ not found.\n";
			}
		   @errors and $! = 1, die @errors;
		}
    }
    endpwent;

	# at the very last, if we went through ... we should check
	# if the dyn loader is executable (2.0.34 needs this)
	foreach (@dynlinker) {
		-x $_ or push @errors, "$0: Dyn. Linker $_ not executable\n";
	}
	@errors and $! = 2, die @errors;
    exit(0);
}

# First copy to dest.tmp then move to dest (for binaries)

sub copy_move {
	my ($src, $dst) = (shift, shift);
	my @cmd;
	my $tmpdst = "$dst.tmp";

	@cmd = ("cp", $src, $tmpdst);
	system(@cmd) and return undef; 
	@cmd = ("mv", $tmpdst, $dst);
	system(@cmd) and return undef;

	return true;
}
# vim:ts=4:sw=4:ai:aw:si:
