#!/usr/bin/perl # # Webschnittstelle fuer die Listenverwaltung # Abonnieren und abmelden der Liste erfolgt ueber Webformular. # Beide Aktionen muessen ueber die Webschnittstelle oder per # E-Mail bestaetigt werden. # # Alle Verwalter-Kommandos lassen sich ebenfalls per Webformular # absetzen. Die Berechtigung wird ueber ein Passwort ermittelt. # Das Passwort steht in der Datei $secretfile in $basedir. # # Die Listendateien befinden sich alle im Verzeichnis $base_dir. # $basedir sollte sich ausserhalb der "document root" befinden # und fuer den www-user schreibbar sein. # # Die Dateiendung ist einheitlich $suffix. Der Pfad zu einer # Liste ist somit $base_dir$FORM{'filename'}$suffix. # Die Namen von Listendateien, die nicht oeffentlich zum # Subskribieren angeboten werden sollen, beginnen mit einem # Punkt. # use strict; #---------------------------------------------------------------------------- # Configuration Section #---------------------------------------------------------------------------- # URL der Homepage # Formulare werden mit
# angesprochen. my $homeurl = "http://somehost.domain.tld"; # Pfad zu sendmail. my $SENDMAIL = "/usr/sbin/sendmail -oi -t"; # Absender der "Confirmation Mail". my $MAILFROM = "webmaster\@somehost.domain.tld"; # Files and Directories # Pfad des cgi-Directory innerhalb von "server-root" my $cgi_dir = "/cgi-bin/"; # Basisverzeichnis der Mailinglisten # Eigentuemer muss der www-daemon-user (e. g. wwwrun) sein! my $base_dir = "/opt/www/etc/listman/"; # Suffix der Listendateien # Das Administrator-Passwort steht in deser Datei my $secretfile = $base_dir . "listman.pw"; my $suffix = ".list"; # Datei der subscriber/unsubscriber candidates (in $base_dir) # Eigentuemer muss der www-daemon-user (e. g. wwwrun) sein! # Format: date|mode|name|email|list|confirmation-id # mode: S=subscribe, U=unsubscribe # Diese Datei wachst mit jeder Subscription (somit auch Logfile) # sollte von Zeit zu Zeit 'log-rotated' werden. my $candfile = $base_dir . "candidates"; # Verwendeter Font (keep "..." within the string) my $FONT = '"Arial,Helvetica,Geneva,Swiss,SunSans-Regular,Sans-Serif"'; # Farben (..BG for background color, ..FO for text color) my $STDBG = "#FFFFFF"; # standard background my $STDFO = "#000000"; # standard text my $TBLBG = "#DDDDDD"; # table background my $STLNK = "#993300"; # unvisited link my $STVLN = "#663300"; # visited link # Header and footer # Standard Header (HTML, between ~ ~) my $HeaderText = qq~ ~; # Standard Footer (HTML, between ~ ~) my $FooterText = qq~ ~; #---------------------------------------------------------------------------- # NOTHING MUST BE CHANGED BELOW #---------------------------------------------------------------------------- #---------------------------------------------------------------------------- # Global Variables #---------------------------------------------------------------------------- $| = 1; my $SENTFROM = "webmaster\@$ENV{'SERVER_NAME'}"; my $script_url = $ENV{'SCRIPT_NAME'}; my %FORM = (); # holds input from forms my $date = ''; # holds actual date my @lists; # names of the valid lists my $killist = ''; # e-mail-adresses to kill my $secret = ''; # password # read password open(PWF, "$secretfile"); $secret = ; chomp($secret); close(PWF); # read list names opendir(LISTDIR, "$base_dir"); @lists = grep(/$suffix$/,readdir(LISTDIR)); closedir(LISTDIR); &DateTime; # Get Date and Time &Parse; # Parse the incoming URL fields print "Content-type: text/html\n\n"; &PageOpen; # Administration section if ($FORM{'action'} eq 'ADMIN' && $FORM{'pass'} eq $secret) { # admin screen &query_form; } elsif ($FORM{'action'} eq 'LIST' && $FORM{'pass'} eq $secret) { # form to delete list members &get_list; } elsif ($FORM{'action'} eq 'PURGE' && $FORM{'pass'} eq $secret) { # really delete list users &purge_names; &query_form; } elsif ($FORM{'action'} eq 'CREATE' && $FORM{'pass'} eq $secret) { # create file &new_file; &query_form; } elsif ($FORM{'action'} eq 'DELETE' && $FORM{'pass'} eq $secret) { # delete file &kill_file; &query_form; } # User section elsif ($FORM{'CID'} ne "") { # process confirmation &DoConfirm($FORM{'CID'}); } elsif ($FORM{'action'} eq 'SUBSCRIBE' || $FORM{'action'} eq 'UNSUBSCRIBE') { # enter candidate &EnterCandidate; } else { # Show Form &DoForm; } &PageClose; # End Main # #---------------------------------------------------------------------------- # Subroutine section #---------------------------------------------------------------------------- ##################################### # A subroutine to die gracefully. ##################################### sub safe_die { print "

$_[0]

\n"; &PageClose; exit; } ##################################### # Set Time and date. ##################################### sub DateTime { my ($sec,$min,$hour,$monthday,$mon,$year,$weekday,$yearday,$isdst) = gmtime(time); $year = $year + 1900; $mon = $mon + 1; $date = "$year-$mon-$monthday"; } ############################## # Header page ############################## sub PageOpen { print qq~ Newsletter Manager ~; print "$HeaderText\n"; } ############################## # Footer routine ############################## sub PageClose { print "$FooterText\n"; print qq~ ~; } ############################## # Parse routine ############################## sub Parse { my ($buffer, $pair, $value, $name); my @pairs; $killist=''; if ($ENV{'REQUEST_METHOD'} eq 'GET') {@pairs = split(/&/, $ENV{'QUERY_STRING'});} elsif ($ENV{'REQUEST_METHOD'} eq 'POST') { read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'}); @pairs = split(/&/, $buffer); } foreach $pair (@pairs) { ($name, $value) = split(/=/, $pair); $name =~ tr/+/ /; $name =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg; $value =~ tr/+/ /; $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg; $value =~ s///g; if ($name eq "killname") { $value =~ s/ //g; $killist = $killist . ' ' . $value; } else { $FORM{$name} = $value; } } } ############################## # Display admin Form ############################## sub query_form { my $item = ''; my $fname = ''; print qq~
Newsletter bearbeiten
Passwort
Newsletterdatei auswählen
Suchbegriff (auch Teilstring) eingeben

Neuen Newsletter anlegen
Passwort
Dateinamen eingeben (versteckte
Newsletter beginnen mit '.')

Newsletter loeschen
Passwort
Newsletterdatei auswählen

~; } ############################## # Get content of Mailinglist ############################## sub get_list { my @thelist = (); my $EMail = ''; print qq~

~; open (INF,"<$base_dir$FORM{'filename'}") || &safe_die("Can't read $FORM{'filename'}"); @thelist=(); close(INF); foreach $EMail (@thelist) { chomp($EMail); if ($EMail =~ /$FORM{'search'}/i || $FORM{'search'} eq "") { print "\n\n"; } } print qq~
 Liste $FORM{'filename'} bearbeiten 
Zum Löschen in der rechten Spalte anklicken

Zurück

Passwort
E-Mail-Addresse Löschen
$EMail "; print ""; print "
~; } ############################## # Neue Listendatei anlegen ############################## sub new_file { my $filename = $FORM{'filename'}; $filename = $filename . $suffix; open (WDR,">$base_dir$filename") || &safe_die("Can't create $filename"); close(WDR); # re-read list names opendir(LISTDIR, "$base_dir"); @lists = grep(/$suffix$/,readdir(LISTDIR)); closedir(LISTDIR); } ############################## # Listendatei loeschen ############################## sub kill_file { my $filename = $FORM{'filename'}; unlink("$base_dir$filename"); # re-read list names opendir(LISTDIR, "$base_dir"); @lists = grep(/$suffix$/,readdir(LISTDIR)); closedir(LISTDIR); } ############################## # Namen aus der Datei loeschen ############################## sub purge_names { my $EMail = ''; my @biglist = (); open (RDR,"<$base_dir$FORM{'filename'}") || &safe_die("Can't read $FORM{'filename'}"); @biglist=; close(RDR); open (WDR,">$base_dir$FORM{'filename'}") || &safe_die("Can't write $FORM{'filename'}"); foreach $EMail(@biglist) { chomp $EMail; unless ($killist =~ /$EMail/) { print WDR "$EMail\n"; } } close(WDR); } ################################## # Add/delete entry of list file ################################## sub DoConfirm #($confirmation id) { # Confirmation in progress my $Subscriber = $_[0]; my $success = 'N'; my @addresses = (); # temporary array for insert/delete my $line = ''; my $anz = 0; open(IN, "$candfile") || &safe_die("Can't open $candfile"); while() { chomp; my ($dat,$mode,$name,$email,$list,$confid) = split(/\|/, $_); if ($confid eq $Subscriber) { open (TMP,"$base_dir$list") || &safe_die("Can't read $list"); @addresses = ; close(TMP); if ($mode eq 'S') { # add mail address $anz = grep(/$email/,@addresses); if ($anz == 0) # avoid duplicates { $line = $email . "\n"; push(@addresses,$line); open (TMP,">$base_dir$list") || &safe_die("Can't write $list"); print TMP @addresses; close(TMP); } } else { # delete mail address open (TMP,">$base_dir$list$suffix") || &safe_die("Can't write $list"); foreach $line(@addresses) { print TMP $line unless $line =~ m/$email/i; } close(TMP); } $success = $mode; last; # Entry found, everything done } } close(IN); # tell what has happened print "

Newsletter Manager

\n"; print "Ihr Newsletter-Abonnement wurde endgültig freigeschaltet.

\n" if ($success eq 'S'); print "Ihr Newsletter-Abonnement wurde endgültig gelöscht.

\n" if ($success eq 'U'); if ($success eq 'N') { print "Beim Bearbeiten Ihres Newsletter-Abonnements trat ein Fehler auf:

\n"; print "Der Freigabecode wurde nicht gefunden (stimmt Ihre Eingabe?)\n"; } } ################################## # Add entry to "candidates" file ################################## sub EnterCandidate { # subscribe or unsubscribe my $Subscriber = ''; my $error = ''; my $line = ''; my $item = ''; my $fname = ''; my $ok = 0; # check email address if (($FORM{'email'} =~ /(@.*@)|(\.\.)|(@\.)|(\.@)|(^\.)|(\.$)/) || ($FORM{'email'} !~ /^.+@\[?(\w|[-.])+\.[a-zA-Z]{2,3}|[0-9]{1,3}\]?$/) || ($FORM{'email'} !~ /^([-\@\w.]+)$/)) { $error = $error . 'E-Mail-Adresse falsch
'; } # make sure the user entered a valid list index $ok = 0; foreach $item (@lists) { $ok = 1 if ($FORM{'filename'} eq $item); } if ($ok == 0) { $error = $error . 'Falscher Wert bei der Listenauswahl
'; } # make sure the user entered a valid name. if ($FORM{'name'} eq '') { $error = $error . 'Bitte geben Sie Ihren Namen ein
'; } if ($error ne '') { print qq~ Die Eingabe ist leider unvollständig oder es hat sich ein Tippfehler eingeschlichen:

$error

Bitte korrigieren Sie Ihre Eingabe und verschicken Sie es noch einmal.

Zurück zum Formular

~; &PageClose; exit; } # now we can peliminary subscribe/unsubscribe and wait for confirmation # make subscriber id srand(time % 1000); $Subscriber = int(rand(999)) . time() . $$ . int(rand(999)); # write to candidate file $line = $date . '|'; if ($FORM{'action'} eq 'SUBSCRIBE') { $line = $line . 'S|';} else { $line = $line . 'U|'; } $line = $line . $FORM{'name'} . '|' . $FORM{'email'} . '|'; $line = $line . $FORM{'filename'} . '|' . $Subscriber; open (OUT,">>$candfile") || &safe_die("Can't add to $candfile"); print OUT "$line\n"; close(OUT); $fname = $FORM{'filename'}; $fname =~ s/$suffix//; &ConfirmationMail($FORM{'email'},$FORM{'action'},$FORM{'filename'},$Subscriber); # tell what has happened print "

Newsletter Manager

\n"; print "Vielen Dank für Ihre Angaben. Ihrem Wunsch entsprechend werden Sie\n"; if ($FORM{'action'} eq 'SUBSCRIBE') { print "für den Newsletter $fname eingetragen\n"; } else { print "beim Newsletter $fname abgemeldet.\n"; } print "Sie erhalten in Kürze eine E-Mail mit einem Bestätigungscode\n"; print "für die endgütige Freischaltung bzw. Abmeldung.

\n"; } ############################## # Send Confirmation Mail ############################## sub ConfirmationMail #(recipient, action, listname, subscriber-id) { my ($recipient, $action, $listname, $subscriber) = @_; $listname =~ s/$suffix//; # send confirmation mail open(MAIL, "| $SENDMAIL") || &safe_die("Can't open $SENDMAIL"); my $oldfh = select MAIL; $| = 1; print MAIL "From: $SENTFROM\n"; print MAIL "To: $recipient\n"; print MAIL "Subject: Bestaetigung Newsletter An-/Abmeldung\n"; print MAIL "Mime-Version: 1.0\n"; print MAIL "Content-Type: text/plain; charset=iso-8859-1\n"; print MAIL "Content-Transfer-Encoding: 8bit\n"; print MAIL "\n"; print MAIL "B e s t a e t i g u n g s a n f o r d e r u n g\n"; if ($action eq 'SUBSCRIBE') { print MAIL "Sie haben den Newsletter $listname abonniert\n"; } else { print MAIL "Sie haben das Abonnement des Newsletters $listname gekuendigt\n"; } print MAIL "Da manche Zeitgenossen sich ein Spass daraus machen, jemand anderen ohne dessen\n"; print MAIL "Wissen einzutragen oder abzumelden, verwenden wir ein Bestaetigungssystem.\n"; print MAIL "Sie erhalten daher einen Bestaetigungscode, den Sie auf der Webseiten eintragen,\n"; print MAIL "bei der Sie auch das Abonnement ein- oder ausgetragen haben. Der Code lautet:\n\n"; print MAIL "$subscriber\n\n"; print MAIL "Falls Ihr Mailprogramm das Anklicken eines Links innerhalb des Textes einer\n"; print MAIL "E-Mail zuläßt, können Sie die Bestätigung gleich aus dem\n"; print MAIL "Mail-Programm heraus erledigen:\n\n"; print MAIL "$homeurl$script_url?CID=$subscriber\n\n"; print MAIL "Im anderen Fall rufen Sie das Anmelde-Formular noch einmal auf und geben\n"; print MAIL " n u r den Bestätigungscode ein (das geht meist per 'Cut-and-Paste'\n"; print MAIL "ueber die Zwischenablage ganz einfach).\n\n"; print MAIL "Sollten Sie sich nicht selbst an- oder abgemeldet haben, ignorieren Sie diese\n"; print MAIL "E-Mail ganz einfach\n\n"; print MAIL "Viele Gruesse, $MAILFROM\n"; select $oldfh; } ############################## # Show initial form ############################## sub DoForm { my ($item, $fname); print qq~

Newsletter-Verwaltung

Sie können mit diesem Formular einen Newsletter abonnieren oder das Abonnement wieder kündigen, indem Sie einen Newsletter auswählen, Namen und E-Mail-Adresse eingeben und auf den Absende-Button klicken.

Da manche Zeitgenossen sich ein Spass daraus machen, jemand anderen ohne dessen Wissen einzutragen oder abzumelden, verwenden wir ein Bestätigungssystem. Sie lassen das Feld "Bestätigungscode" zunächst leer. Nach dieser Erstanmeldung erhalten Sie per E-Mail den Bestätigungscode.

Falls Ihr Mailprogramm das Anklicken eines Links innerhalb des Textes einer E-Mail zuläßt, können Sie die Bestätigung gleich aus dem Mail-Programm heraus erledigen. Im anderen Fall rufen Sie dieses Formular noch einmal auf und geben nur den Bestätigungscode ein (das geht meist per "Cut-and-Paste" über die Zwischenablage ganz einfach).

Newsletter abonnieren/kündigen

Name des Newsletters:
Ihr Vorname und Name:
Ihre E-Mail-Adresse:
Was möchten Sie tun? Newsletter abonnieren
Abonnement kündigen

Abonnement/Kündigung bestätigen

Ihr Bestätigungscode:
(Aus der E-Mail)

Newsletter administrieren

Passwort:
~; }