#!/usr/local/bin/perl #From owner-unix-listproc@avs.com Thu Sep 1 15:02:20 1994 #Return-Path: #Received: from pitbull.avs.com by caffeine (5.0/SMI-SVR4) #id AA25991; Thu, 1 Sep 94 14:54:29 EDT #Received: from (pitbull.avs.com) by pitbull.avs.com (4.1/SMI-4.1) #id AA12395; Thu, 1 Sep 94 14:56:21 EDT #Received: from caffeine (caffeine.avs.com) by pitbull.avs.com (4.1/SMI-4.1) #id AA12363; Thu, 1 Sep 94 14:55:09 EDT #Received: from hooch.CC.Lehigh.EDU by caffeine (5.0/SMI-SVR4) #id AA25975; Thu, 1 Sep 94 14:53:12 EDT #Received: by hooch.CC.Lehigh.EDU (AIX 3.2/UCB 5.64/4.03) #id AA18268; Thu, 1 Sep 1994 14:56:07 -0400 #Message-Id: <9409011856.AA18268@hooch.CC.Lehigh.EDU> #Date: Thu, 1 Sep 1994 14:56:07 -0400 (EDT) #Reply-To: lujce@hooch.CC.Lehigh.EDU #Sender: owner-unix-listproc@avs.com #From: lujce@hooch.CC.Lehigh.EDU #To: "ListProcessor 6.0 Support List" #Subject: Re: List owner archive files? #In-Reply-To: <9408301907.AA29589@caffeine> from "Lorraine Padour" at Aug 30, 94 02:07:14 pm #Content-Type: text #X-To: lpadour@nwu.edu #X-Mailer: ELM [version 2.4 PL23] #X-Listprocessor-Version: 7.01 -- ListProcessor by CREN #content-length: 7190 #X-Procmail-Version: 3.05 #Status: RO # #> Can a list owner archive files via email and how do you indicate that this #> is a file not a message? I see in the server man page that you can describe #> the file in the subject which leads me to believe this is possible. # #Lorraine, # #No, not with the stock system. I was spoiled by the BITNET Listserv, which #does allow list owners to archive files, so I wrote the following perl program #to allow list owners to at least put, replace, and delete files. Use at your #own risk, etc. If anyone makes enhancements, please send them to me. Thanks! #I'm using zmailer(mea) and listproc 1.6b, and have had no problems with it so #far. # #Don't forget to: # #- setup the mailer alias, assuming the program is in /usr/server/local: #archive: "|/usr/server/local/archive" #- set ownership (user listproc and maybe group system) and #permissions on the program: chmod u+sx and maybe g+sx, o+x #- change the variables at the top of the script to suit #- I put the files in the anonymous FTP area, make sure $DIRPATH is #writable by user listproc and/or group system #- you'll have to change the "farch" commands if you don't want to #use $DIRPATH #- if you're using a more recent listproc, you could set the environ- #ment variable ULISTPROC_ARCHIVES_UMASK=022 and maybe remove the #umask and chmod calls. Also, farch now has a switch to allow a #file to be updated. For a replace operation this program deletes #the file ("farch -r") then invokes farch again to store it. # #A list owner should now be able to mail a file to archive@yourhost. The #first line of the file must be the put/replace/delete command. Enjoy, and #let me know if I can assist in any way. # #/jim # #------------------------------------------------------------------------------- #!/usr/local/bin/perl # File Archive Facility for the ListProc - lujce@Lehigh.EDU # # This perl program needs to run under the ListProcessor id. I use # permissions: # # -rws--s--x 1 listserv system 5176 Jul 29 12:52 archive # # It should be invoked via a mail alias, like so: # # archive: "|/usr/server/local/archive" # # The first line of the body of the mail message (on STDIN) should contain a # line of the form: # # (put|replace|delete) list password file [description] # # 07.30.94 JCE Allow pathname beginning with one "." require "ctime.pl"; $pid = $$; $CONTACT = 'lujce@Lehigh.EDU'; $OWNERS = "/usr/server/owners"; $CONFIG = "/usr/server/config"; $DIRPATH = "/u/ftp/pub/listserv"; $ARCHPATH = "/usr/server/archives"; $TEMPDIR = "/tmp/archive.$pid"; $TEMPLOG = "$TEMPDIR/.log"; $MAIL = "$TEMPDIR/.mail"; $PERMLOG = "/usr/server/local/archive.log"; mkdir("$TEMPDIR", 0700) || die "mkdir $TEMPDIR:$!\n"; open(TEMPLOG, ">$TEMPLOG") || die "open $TEMPLOG:$!\n"; open(STDOUT, ">&TEMPLOG") || die "open STDOUT:$!\n"; open(STDERR, ">&TEMPLOG") || die "open STDERR:$!\n"; select(STDERR); $| = 1; select(STDOUT); $| = 1; umask(022); # Write files with permissions -rwxr-xr-x $ENV{'TZ'} = "EST5EDT"; chop($date = &ctime(time)); $_ = <>; # Get the address from the "From " line. if (($from) = (/^From\s+(\S+)/)) { print "\t+ request from $from\n"; } else { &done("\t+ request from unknown origin, ABORTED\n"); } push(@header, $_); # Save the "From " line. while (<>) { # Gobble-up the rest of the header and save it. push(@header, $_); last if /^\s*$/; } $_ = <>; # Get the command line chop; ($command, $list, $pass, $file, $desc) = split(/\s+/, $_, 5); &done("\t+ missing command\n") unless defined($command); &done("\t+ missing list name\n") unless defined($list); &done("\t+ missing password\n") unless defined($pass); &done("\t+ missing filename\n") unless defined($file); VCMD: { # Verify the command if ($command =~ /^put/i) { $PUT = 1; last VCMD; } if ($command =~ /^rep/i) { $REP = 1; last VCMD; } if ($command =~ /^del/i) { $DEL = 1; last VCMD; } if ($command =~ /^get/i) { $GET = 1; last VCMD; } if ($command =~ /^ind/i) { $IND = 1; last VCMD; } &done("\t+ invalid command \"$command\"\n"); } # Verify list name. &done("\t+ bad list name\n") if $list =~ /[^\-\w]/; $list =~ tr/A-Z/a-z/; # &done("\t+ list does not exist\n") unless -d "$ARCHPATH/$list"; # Seperate the file path (if any) and file name. @filepath = split('/', $file); $filename = pop(@filepath); $filepath = join('/', @filepath); # Verify file path. &done("\t+ bad filepath\n") if $filepath =~ /^[\/\$\~]/; &done("\t+ bad filepath\n") if $filepath =~ /\.\./; # Verify the "From " address in the OWNERS file. open OWNERS || &done("\t+ open OWNERS failed: $!\n"); while () { if (/^$from\s+$list/i) { $owner = 1; last; } } close OWNERS; &done("\t+ unauthorized\n") unless $owner; # Verify the password in the CONFIG file. open CONFIG || &done("\t+ open CONFIG failed: $!\n"); while () { if (/^list\s+$list\s+\S+\s+\S+\s+$pass\s+/i) { $putokay = 1; last; } } close CONFIG; &done("\t+ unauthorized\n") unless $putokay; print "\t+ $from is authorized\n"; # Copy the rest of STDIN to a temp file. open(TMP, ">$TEMPDIR/$filename") || &done("\t+ open TMP failed: $!\n"); while (<>) { last if /^--$/; print TMP; } close TMP; # Archive the file. print "\t+ attempting to $command file $list/$filepath/$filename\n"; if (-e "$DIRPATH/$list/$filepath/$filename" || -e "$DIRPATH/$list/$filepath/$filename.Z") { if ($REP || $DEL) { system "/usr/server/farch -r -d $DIRPATH/$list/$filepath -a $list/$filepath $filename" } else { &done("\t+ file already exists\n"); } } if ($PUT || $REP) { if (defined($desc)) { system "/usr/server/farch -n -d $DIRPATH/$list/$filepath -a $list/$filepath -D \"$desc\" $TEMPDIR/$filename"; } else { system "/usr/server/farch -n -d $DIRPATH/$list/$filepath -a $list/$filepath $TEMPDIR/$filename"; } } if (-e "$DIRPATH/$list/$filepath/$filename" || -e "$DIRPATH/$list/$filepath/$filename.Z") { if ($PUT || $REP) { chmod 0644, "$DIRPATH/$list/$filepath/$filename"; chmod 0644, "$DIRPATH/$list/$filepath/$filename.Z"; &done("\t+ the operation appears to have been a success\n"); } else { &done("\t+ something went wrong, file still exists\n"); } } else { if ($DEL) { &done("\t+ the operation appears to have been a success\n"); } else { &done("\t+ something went wrong, file does not exist\n"); } } sub done { local($string) = @_; warn "$string" if $string; open(MAIL, ">$MAIL") || die "$MAIL:$!\n"; print MAIL <> $MAIL"; system "/usr/lib/sendmail $from < $MAIL" if $from; system "cat $TEMPLOG >> $PERMLOG"; unlink "$MAIL"; unlink "$TEMPLOG"; unlink "$TEMPDIR/$filename"; rmdir "$TEMPDIR"; exit 0; } #-------------------------------------------------------------------------------