index.cgi
changeset 7 c89c297e5d53
parent 6 641140d445ca
child 8 562be4ad4e6d
equal deleted inserted replaced
6:641140d445ca 7:c89c297e5d53
    16 use File::Basename;
    16 use File::Basename;
    17 use Mail::RFC822::Address qw(valid);
    17 use Mail::RFC822::Address qw(valid);
    18 
    18 
    19 sub insert(\%);
    19 sub insert(\%);
    20 sub confirm($$);
    20 sub confirm($$);
    21 sub slurp($);
    21 sub read_conf($);
    22 
    22 
    23 
    23 
    24 delete @ENV{grep /PATH$/ => keys %ENV};
    24 delete @ENV{grep /PATH$/ => keys %ENV};
    25 $ENV{PATH} = "/usr/bin:/usr/sbin:/bin:/sbin";
    25 $ENV{PATH} = "/usr/bin:/usr/sbin:/bin:/sbin";
    26 
    26 
    27 my $DSN = "DBI:SQLite:var/db.sqlite3";
    27 my $DSN = "DBI:SQLite:var/db.sqlite3";
    28 my $SECRET = slurp "conf/secret";   chomp($SECRET);
    28 my $SECRET = read_conf "conf/secret";   chomp($SECRET);
    29 my $SELF = slurp "conf/self";       chomp($SELF);
    29 my $SELF = read_conf "conf/self";       chomp($SELF);
    30 my $SUBJECT = slurp "conf/subject"; chomp($SUBJECT);
       
    31 my $EXPIRATION = 60;		    # the link is valid for XX minutes only
    30 my $EXPIRATION = 60;		    # the link is valid for XX minutes only
       
    31 my $SENDMAIL = "/usr/sbin/sendmail -t";
    32 my %FIELDS = (
    32 my %FIELDS = (
    33     MAN => [qw[givenname surname mail]],
    33     MAN => [qw[givenname surname mail]],
    34     OPT => [qw[tel]]
    34     OPT => [qw[tel]]
    35 );
    35 );
    36 
    36 
    37 my %ttconfig = (
    37 my %ttconfig = (
    38     INCLUDE_PATH => "templates",
    38     INCLUDE_PATH => "templates",
    39     DEBUG => 1,
    39     DEBUG => 1,
    40     VARIABLES => {
       
    41 	MAILTO => "hs+retter\@schlittermann.de"
       
    42     },
       
    43 );
    40 );
    44 
    41 
    45 my $DBH = DBI->connect($DSN, undef, undef, {RaiseError=>1});
    42 my $DBH = DBI->connect($DSN, undef, undef, {RaiseError=>1});
    46 END { $DBH and $DBH->disconnect }
    43 END { $DBH and $DBH->disconnect }
    47 
    44 
    73 		my $xxx = encrypt(time);
    70 		my $xxx = encrypt(time);
    74 		$xxx =~ s/\+/-/g;
    71 		$xxx =~ s/\+/-/g;
    75 		$xxx =~ s/\//_/g;
    72 		$xxx =~ s/\//_/g;
    76 
    73 
    77 		# send mail
    74 		# send mail
    78 		sendmail(To => scalar(param("mail")),
    75 		open(my $sendmail => "|$SENDMAIL")
    79 		         From => "hs+retter\@schlittermann.de",
    76 		    or die "Can't open sendmail: $!\n";
    80 			 Sender => "hs\@schlittermann.de",
    77 
    81 			 Subject => "$SUBJECT Link zur Online-Anmeldung",
    78 		$tt->process("mail.invitation.tpl", {
    82 			 Message => "Bitte benutze den folgenden Link, um zum Anmeldeformular zu gelangen:\n"
    79 		    to   => scalar(param("mail")),
    83 			    . "$SELF/$xxx.tmp\n"
    80 		    url  => "$SELF/$xxx.tmp"}, $sendmail)
    84 			    . "\n-- \nHeiko Schlittermann\n");
    81 		or die $tt->error();
    85 		    
    82 		close($sendmail);
       
    83 
    86 		$sent = param("mail");
    84 		$sent = param("mail");
    87 	    }
    85 	    }
    88 	}
    86 	}
    89 	$tt->process("access.tpl", {
    87 	$tt->process("access.tpl", {
    90 	    sent => $sent,
    88 	    sent => $sent,
   119     if (path_info() =~ /^\/?(.*)\.user$/) {
   117     if (path_info() =~ /^\/?(.*)\.user$/) {
   120 	my $uuid = $1;
   118 	my $uuid = $1;
   121 	my $confirmed = param("confirm") eq "yes";
   119 	my $confirmed = param("confirm") eq "yes";
   122 	my %data = confirm($uuid => $confirmed);
   120 	my %data = confirm($uuid => $confirmed);
   123 
   121 
       
   122 	open(my $sendmail, "|$SENDMAIL") or die "Can't open $SENDMAIL: $!\n";
       
   123 	$tt->process("mail.confirmed.tpl", {
       
   124 	    to => $data{mail},
       
   125 	    confirmed => $confirmed,
       
   126 	}, $sendmail)
       
   127 	or die $tt->error();
       
   128 	close($sendmail);
       
   129 
   124 	$tt->process("confirm.tpl", {
   130 	$tt->process("confirm.tpl", {
   125 	    confirmed => $confirmed,
   131 	    confirmed => $confirmed,
   126 	    error => delete $data{error},
   132 	    error => delete $data{error},
   127 	    value => \%data}) or die $tt->error();
   133 	    value => \%data}) or die $tt->error();
   128 	exit 0;
   134 	exit 0;
   169 	    $warn{$_} = join " ", @{$warn{$_}};
   175 	    $warn{$_} = join " ", @{$warn{$_}};
   170 	}
   176 	}
   171 
   177 
   172 	if (!%warn) {
   178 	if (!%warn) {
   173 	    my %r = insert(%value);
   179 	    my %r = insert(%value);
   174 	    sendmail(To => $value{mail},
   180 
   175 		     From => "hs\@schlittermann.de",
   181 	    open(my $sendmail => "|$SENDMAIL")
   176 		     "Content-Type" => "text/plain; charset=\"UTF-8\"",
   182 		or die "Can't open $SENDMAIL: $!\n";
   177 		     Subject => "$SUBJECT Bitte die Anmeldung bestaetigen.",
   183 
   178 		     Message => <<_EOF);
   184 	    $tt->process("mail.confirm.tpl", {
   179 
   185 		to => $value{mail},
   180 Bitte bestaetige Deine Anmeldung. Dazu mußt Du folgenden Link in Deinem
   186 		url => {
   181 Browser oeffnen:
   187 		    yes => "$SELF/$r{uuid}.user?confirm=yes",
   182 
   188 		    no  => "$SELF/$r{uuid}.user?confirm=no",
   183 $SELF/$r{uuid}.user?confirm=yes
   189 		}
   184 
   190 	    }, $sendmail)
   185 Wenn alles nur ein Irrtum war, dann kannst Du Deine Daten wieder
   191 	    or die $tt->error();
   186 AUSTRAGEN und wir vergessen Deine Anmeldung. Hier ist der Link zum
   192 
   187 AUSTRAGEN:
   193 	    close($sendmail);
   188 
   194 
   189 $SELF/$r{uuid}.user?confirm=no
       
   190 
       
   191 _EOF
       
   192 	    $tt->process("form.ack.tpl", {
   195 	    $tt->process("form.ack.tpl", {
   193 		value => \%value,
   196 		value => \%value,
   194 		timestamp => $r{timestamp},
   197 		timestamp => $r{timestamp},
   195 		uuid => $r{uuid},
   198 		uuid => $r{uuid},
   196 	    }) or die $tt->error();
   199 	    }) or die $tt->error();
   263 	}
   266 	}
   264 	$sth->execute($uuid);
   267 	$sth->execute($uuid);
   265 	
   268 	
   266     $DBH->commit;
   269     $DBH->commit;
   267 
   270 
   268     if ($confirmed) {
       
   269 	sendmail(
       
   270 	    To => $data{mail},
       
   271 	    From => "hs+retter\@schlittermann.de",
       
   272 	    Subject => "$SUBJECT Bestaetigung der Anmeldung",
       
   273 	    Message => <<_EOF);
       
   274 Du bist erfolgreich angemeldet. Fuer weitere Fragen kontaktiere bitte
       
   275 hs+retter\@schlittermann.de.
       
   276 _EOF
       
   277     }
       
   278     else {
       
   279 	sendmail(
       
   280 	    To => $data{mail},
       
   281 	    From => "hs+retter\@schlittermann.de",
       
   282 	    Subject => "$SUBJECT Bestaetigung der NICHT-Anmeldung",
       
   283 	    Message => <<_EOF);
       
   284 Wir vergessen Deine Anmeldung. Fuer weitere Fragen kontaktiere bitte
       
   285 hs+retter\@schlittermann.de.
       
   286 _EOF
       
   287     }
       
   288 
       
   289     return %data;
   271     return %data;
   290 }
   272 }
   291 
   273 
   292 sub slurp($) {
   274 sub read_conf($) {
   293     open(my $_, $_[0]) or die "Can't open $_[0]: $!\n";
   275     open(my $_, $_[0]) or die "Can't open $_[0]: $!\n";
   294     local $/ = undef;
   276     local $/ = undef;
   295     s/^#.*//mg;
   277     s/^#.*//mg;
   296     return <$_>;
   278     return <$_>;
   297 }
   279 }