home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Internet Tools 1995 April / Internet Tools.iso / mail / listserv / utils / owner_archive.pl.Z / owner_archive.pl
Encoding:
Perl Script  |  1994-09-06  |  8.2 KB  |  263 lines
  1. #!/usr/local/bin/perl
  2. #From owner-unix-listproc@avs.com  Thu Sep  1 15:02:20 1994
  3. #Return-Path: <owner-unix-listproc@avs.com>
  4. #Received: from pitbull.avs.com by caffeine (5.0/SMI-SVR4)
  5. #id AA25991; Thu, 1 Sep 94 14:54:29 EDT
  6. #Received: from  (pitbull.avs.com) by pitbull.avs.com (4.1/SMI-4.1)
  7. #id AA12395; Thu, 1 Sep 94 14:56:21 EDT
  8. #Received: from caffeine (caffeine.avs.com) by pitbull.avs.com (4.1/SMI-4.1)
  9. #id AA12363; Thu, 1 Sep 94 14:55:09 EDT
  10. #Received: from hooch.CC.Lehigh.EDU by caffeine (5.0/SMI-SVR4)
  11. #id AA25975; Thu, 1 Sep 94 14:53:12 EDT
  12. #Received: by hooch.CC.Lehigh.EDU (AIX 3.2/UCB 5.64/4.03)
  13. #id AA18268; Thu, 1 Sep 1994 14:56:07 -0400
  14. #Message-Id: <9409011856.AA18268@hooch.CC.Lehigh.EDU>
  15. #Date: Thu, 1 Sep 1994 14:56:07 -0400 (EDT)
  16. #Reply-To: lujce@hooch.CC.Lehigh.EDU
  17. #Sender: owner-unix-listproc@avs.com
  18. #From: lujce@hooch.CC.Lehigh.EDU
  19. #To: "ListProcessor 6.0 Support List" <unix-listproc@avs.com>
  20. #Subject: Re: List owner archive files?
  21. #In-Reply-To: <9408301907.AA29589@caffeine> from "Lorraine Padour" at Aug 30, 94 02:07:14 pm
  22. #Content-Type: text
  23. #X-To: lpadour@nwu.edu
  24. #X-Mailer: ELM [version 2.4 PL23]
  25. #X-Listprocessor-Version: 7.01 -- ListProcessor by CREN
  26. #content-length: 7190
  27. #X-Procmail-Version: 3.05
  28. #Status: RO
  29. #
  30. #> Can a list owner archive files via email and how do you indicate that this
  31. #> is a file not a message?  I see in the server man page that you can describe
  32. #> the file in the subject which leads me to believe this is possible.
  33. #
  34. #Lorraine,
  35. #
  36. #No, not with the stock system.  I was spoiled by the BITNET Listserv, which
  37. #does allow list owners to archive files, so I wrote the following perl program
  38. #to allow list owners to at least put, replace, and delete files.  Use at your
  39. #own risk, etc.  If anyone makes enhancements, please send them to me.  Thanks!
  40. #I'm using zmailer(mea) and listproc 1.6b, and have had no problems with it so
  41. #far.  
  42. #
  43. #Don't forget to:
  44. #
  45. #- setup the mailer alias, assuming the program is in /usr/server/local:
  46. #archive: "|/usr/server/local/archive" 
  47. #- set ownership (user listproc and maybe group system) and
  48. #permissions on the program: chmod u+sx and maybe g+sx, o+x
  49. #- change the variables at the top of the script to suit
  50. #- I put the files in the anonymous FTP area, make sure $DIRPATH is
  51. #writable by user listproc and/or group system
  52. #- you'll have to change the "farch" commands if you don't want to
  53. #use $DIRPATH
  54. #- if you're using a more recent listproc, you could set the environ-
  55. #ment variable ULISTPROC_ARCHIVES_UMASK=022 and maybe remove the
  56. #umask and chmod calls.  Also, farch now has a switch to allow a
  57. #file to be updated.  For a replace operation this program deletes
  58. #the file ("farch -r") then invokes farch again to store it.
  59. #
  60. #A list owner should now be able to mail a file to archive@yourhost.  The
  61. #first line of the file must be the put/replace/delete command.  Enjoy, and
  62. #let me know if I can assist in any way.
  63. #
  64. #/jim
  65. #
  66. #-------------------------------------------------------------------------------
  67. #!/usr/local/bin/perl
  68.  
  69. # File Archive Facility for the ListProc - lujce@Lehigh.EDU
  70. #
  71. # This perl program needs to run under the ListProcessor id.  I use
  72. # permissions:
  73. #
  74. #   -rws--s--x   1 listserv system      5176 Jul 29 12:52 archive
  75. #
  76. # It should be invoked via a mail alias, like so:
  77. #
  78. #   archive: "|/usr/server/local/archive"
  79. #
  80. # The first line of the body of the mail message (on STDIN) should contain a
  81. # line of the form:
  82. #
  83. #   (put|replace|delete) list password file [description]
  84. #
  85. # 07.30.94 JCE Allow pathname beginning with one "." 
  86.  
  87. require "ctime.pl";
  88.  
  89. $pid = $$;
  90. $CONTACT = 'lujce@Lehigh.EDU';
  91. $OWNERS = "/usr/server/owners";
  92. $CONFIG = "/usr/server/config";
  93. $DIRPATH = "/u/ftp/pub/listserv";
  94. $ARCHPATH = "/usr/server/archives";
  95. $TEMPDIR = "/tmp/archive.$pid";
  96. $TEMPLOG = "$TEMPDIR/.log";
  97. $MAIL = "$TEMPDIR/.mail";
  98. $PERMLOG = "/usr/server/local/archive.log";
  99.  
  100. mkdir("$TEMPDIR", 0700) || die "mkdir $TEMPDIR:$!\n";
  101. open(TEMPLOG, ">$TEMPLOG") || die "open $TEMPLOG:$!\n";
  102. open(STDOUT, ">&TEMPLOG") || die "open STDOUT:$!\n";
  103. open(STDERR, ">&TEMPLOG") || die "open STDERR:$!\n";
  104. select(STDERR); $| = 1;
  105. select(STDOUT); $| = 1;
  106.  
  107. umask(022);            # Write files with permissions -rwxr-xr-x
  108. $ENV{'TZ'} = "EST5EDT";
  109. chop($date = &ctime(time));
  110.  
  111. $_ = <>;            # Get the address from the "From " line.
  112. if (($from) = (/^From\s+(\S+)/)) {
  113.    print "\t+ request from $from\n";
  114. }
  115. else {
  116.    &done("\t+ request from unknown origin, ABORTED\n");
  117. }
  118.  
  119. push(@header, $_);        # Save the "From " line.
  120.  
  121. while (<>) {            # Gobble-up the rest of the header and save it.
  122.    push(@header, $_);
  123.    last if /^\s*$/;
  124. }
  125.  
  126. $_ = <>;            # Get the command line
  127. chop;
  128. ($command, $list, $pass, $file, $desc) = split(/\s+/, $_, 5);
  129. &done("\t+ missing command\n") unless defined($command);
  130. &done("\t+ missing list name\n") unless defined($list);
  131. &done("\t+ missing password\n") unless defined($pass);
  132. &done("\t+ missing filename\n") unless defined($file);
  133.  
  134. VCMD: {                # Verify the command
  135.    if ($command =~ /^put/i) { $PUT = 1; last VCMD; }
  136.    if ($command =~ /^rep/i) { $REP = 1; last VCMD; }
  137.    if ($command =~ /^del/i) { $DEL = 1; last VCMD; }
  138.    if ($command =~ /^get/i) { $GET = 1; last VCMD; }
  139.    if ($command =~ /^ind/i) { $IND = 1; last VCMD; }
  140.    &done("\t+ invalid command \"$command\"\n");
  141. }
  142.  
  143. # Verify list name.
  144.  
  145. &done("\t+ bad list name\n") if $list =~ /[^\-\w]/;
  146. $list =~ tr/A-Z/a-z/;
  147. # &done("\t+ list does not exist\n") unless -d "$ARCHPATH/$list";
  148.  
  149. # Seperate the file path (if any) and file name.
  150.  
  151. @filepath = split('/', $file);
  152. $filename = pop(@filepath);
  153. $filepath = join('/', @filepath);
  154.  
  155. # Verify file path.
  156.  
  157. &done("\t+ bad filepath\n") if $filepath =~ /^[\/\$\~]/;
  158. &done("\t+ bad filepath\n") if $filepath =~ /\.\./;
  159.  
  160. # Verify the "From " address in the OWNERS file.
  161.  
  162. open OWNERS || &done("\t+ open OWNERS failed: $!\n");
  163. while (<OWNERS>) {
  164.    if (/^$from\s+$list/i) {
  165.       $owner = 1;
  166.       last;
  167.    }
  168. }
  169. close OWNERS;
  170. &done("\t+ unauthorized\n") unless $owner;
  171.  
  172. # Verify the password in the CONFIG file.
  173.  
  174. open CONFIG || &done("\t+ open CONFIG failed: $!\n");
  175. while (<CONFIG>) {
  176.    if (/^list\s+$list\s+\S+\s+\S+\s+$pass\s+/i) {
  177.       $putokay = 1;
  178.       last;
  179.    }
  180. }
  181. close CONFIG;
  182. &done("\t+ unauthorized\n") unless $putokay;
  183.  
  184. print "\t+ $from is authorized\n";
  185.  
  186. # Copy the rest of STDIN to a temp file.
  187.  
  188. open(TMP, ">$TEMPDIR/$filename") || &done("\t+ open TMP failed: $!\n");
  189. while (<>) {
  190.    last if /^--$/;
  191.    print TMP;
  192. }
  193. close TMP;
  194.  
  195. # Archive the file.
  196.  
  197. print "\t+ attempting to $command file $list/$filepath/$filename\n";
  198.  
  199. if (-e "$DIRPATH/$list/$filepath/$filename" || -e "$DIRPATH/$list/$filepath/$filename.Z") {
  200.    if ($REP || $DEL) {
  201.       system "/usr/server/farch -r -d $DIRPATH/$list/$filepath -a $list/$filepath $filename"
  202.    }
  203.    else {
  204.       &done("\t+ file already exists\n");
  205.    }
  206. }
  207.  
  208. if ($PUT || $REP) {
  209.    if (defined($desc)) {
  210.       system "/usr/server/farch -n -d $DIRPATH/$list/$filepath -a $list/$filepath -D \"$desc\" $TEMPDIR/$filename";
  211.    }
  212.    else {
  213.       system "/usr/server/farch -n -d $DIRPATH/$list/$filepath -a $list/$filepath $TEMPDIR/$filename";
  214.    }
  215. }
  216.  
  217. if (-e "$DIRPATH/$list/$filepath/$filename" || -e "$DIRPATH/$list/$filepath/$filename.Z") {
  218.    if ($PUT || $REP) {
  219.       chmod 0644, "$DIRPATH/$list/$filepath/$filename";
  220.       chmod 0644, "$DIRPATH/$list/$filepath/$filename.Z";
  221.       &done("\t+ the operation appears to have been a success\n");
  222.    }
  223.    else {
  224.       &done("\t+ something went wrong, file still exists\n");
  225.    }
  226. }
  227. else {
  228.    if ($DEL) {
  229.       &done("\t+ the operation appears to have been a success\n");
  230.    }
  231.    else {
  232.       &done("\t+ something went wrong, file does not exist\n");
  233.    }
  234. }
  235.  
  236. sub done {
  237.  
  238.    local($string) = @_;
  239.    warn "$string" if $string;
  240.    open(MAIL, ">$MAIL") || die "$MAIL:$!\n";
  241.    print MAIL <<EOM;
  242. \n$date -- File Archive Facility\n
  243. \tNote: This facility is under development...  Messages beginning
  244. \t      with a \"+\" are from this facility, other messages are from
  245. \t      the ListProcessor \"farch\" utility.  Refer comments, questions,
  246. \t      etc. to $CONTACT.\n
  247. EOM
  248.    close MAIL;
  249.    close STDOUT;
  250.    close STDERR;
  251.    close TEMPLOG;
  252.    system "cat $TEMPLOG >> $MAIL";
  253.    system "/usr/lib/sendmail $from < $MAIL" if $from;
  254.    system "cat $TEMPLOG >> $PERMLOG";
  255.    unlink "$MAIL";
  256.    unlink "$TEMPLOG";
  257.    unlink "$TEMPDIR/$filename";
  258.    rmdir "$TEMPDIR";
  259.    exit 0;
  260. }
  261. #-------------------------------------------------------------------------------
  262.  
  263.