#!/opt/local/bin/perl # # archiver.pl # # Program to automatically archive the CSSN list # Copyright 2000-2001 Michael Castleman. # # 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA # # Usage: have procmail automatically pipe a copy of all CSSN emails # to this script. # use strict; # Constants my $ARCHIVEROOT = "/www/data/cu/cssn/cssn-list/"; my $TITLE = "CSSN List Archives: "; my $INDEX = "index.html"; my $GID = 5205; ############################################################################### sub setperm ($) { my $file = $_[0]; my $mode = (-d $file ? 0775 : 0664); unless (chown $<, $GID, $file) { warn("couldn't chown: $!"); } else { chmod $mode, $file or warn("couldn't chmod: $!"); } } sub chmkdir($) { unless (-d $_[0]) { mkdir $_[0], 0777 or die("couldn't mkdir $_[0]: $!"); setperm $_[0]; } chdir $_[0] or die("couldn't chdir $_[0]: $!"); } sub fixup (\$) { my $f = $_[0]; # replace special characters with entities $$f =~ s/\&/\&\;/g; $$f =~ s/\/\>\;/g; # hyperlink emails and URLs $$f =~ s/([\w\-\.]+\@[\w\-\.]+)/\$1\<\/a\>/g; $$f =~ s/([a-z]+\:\/\/[^\s\>]+)/\$1\<\/a\>/g; } chdir $ARCHIVEROOT or die("couldn't chdir: $!"); my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time); my @months = ("January", "February", "March", "April", "May", "June", "July", "August", "September", "October", "November", "December"); chmkdir $year + 1900; chmkdir sprintf("%02d", $mon + 1); my $fn; my $max = 0; opendir DIR, "." or die ("can't opendir: $!"); foreach $fn (readdir(DIR)) { if ($fn =~ /^([0-9]*)\.html$/i && ($max < $1)) { $max = $1; } } $fn = sprintf("%05u.html", $max + 1); open HTML, ">$fn" or die ("couldn't create $fn: $!"); my $subj; my ($from, $date); my @headers; my $havesubj = 0; do { $_ = <>; chomp; fixup $_; push @headers, $_; if ($havesubj && /^\s/) { s/^\s+/ /; $subj .= $_; } elsif (/^Subject: (.*)$/) { $subj = $1; $havesubj = 1; } else { $havesubj = 0; if (/^From: (.*)$/i) { $from = $1; } elsif (/^Date: (.*)$/i) { $date = $1; } } } while ($_ ne ""); print HTML ' '.$subj.'

'.$subj.'

';

foreach (@headers) { print HTML "$_\n" }

while (<>) {
    fixup $_;
    print HTML $_;
}

print HTML "
\n"; close HTML; setperm $fn; unless (-f $INDEX) { my $title = $TITLE . $months[$mon] . " " . ($year + 1900); open INDEX, ">$INDEX" or die ("can't create index.html: $!"); setperm $INDEX; print INDEX ' '.$title.'

'.$title.'