index.cgi
changeset 8 562be4ad4e6d
parent 7 c89c297e5d53
child 9 32a383000254
equal deleted inserted replaced
7:c89c297e5d53 8:562be4ad4e6d
    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 = read_conf "conf/secret";   chomp($SECRET);
    28 my $EXPIRATION = 60;  # expiration time of the first link
    29 my $SELF = read_conf "conf/self";       chomp($SELF);
    29 my $SECRET = read_conf "conf/secret";
    30 my $EXPIRATION = 60;		    # the link is valid for XX minutes only
    30 my $SELF = read_conf "conf/self";   
    31 my $SENDMAIL = "/usr/sbin/sendmail -t";
    31 my $SENDER = read_conf "conf/sender";
       
    32 my $SENDMAIL = "/usr/sbin/sendmail -f $SENDER -t";
       
    33 
    32 my %FIELDS = (
    34 my %FIELDS = (
    33     MAN => [qw[givenname surname mail]],
    35     MAN => [qw[givenname surname mail]],
    34     OPT => [qw[tel]]
    36     OPT => [qw[tel]]
    35 );
    37 );
    36 
    38 
    37 my %ttconfig = (
    39 my %ttconfig = (
    38     INCLUDE_PATH => "templates",
    40     INCLUDE_PATH => "templates",
    39     DEBUG => 1,
       
    40 );
    41 );
    41 
    42 
    42 my $DBH = DBI->connect($DSN, undef, undef, {RaiseError=>1});
    43 my $DBH = DBI->connect($DSN, undef, undef, {RaiseError=>1});
    43 END { $DBH and $DBH->disconnect }
    44 END { $DBH and $DBH->disconnect }
    44 
    45 
    77 
    78 
    78 		$tt->process("mail.invitation.tpl", {
    79 		$tt->process("mail.invitation.tpl", {
    79 		    to   => scalar(param("mail")),
    80 		    to   => scalar(param("mail")),
    80 		    url  => "$SELF/$xxx.tmp"}, $sendmail)
    81 		    url  => "$SELF/$xxx.tmp"}, $sendmail)
    81 		or die $tt->error();
    82 		or die $tt->error();
    82 		close($sendmail);
    83 		close($sendmail)
       
    84 			or die "problem sending mail to "
       
    85 				. param("mail");
    83 
    86 
    84 		$sent = param("mail");
    87 		$sent = param("mail");
    85 	    }
    88 	    }
    86 	}
    89 	}
    87 	$tt->process("access.tpl", {
    90 	$tt->process("html.access.tpl", {
    88 	    sent => $sent,
    91 	    sent => $sent,
    89 	    warn => %warn ? \%warn : undef,
    92 	    warn => %warn ? \%warn : undef,
    90 	    expires => $EXPIRATION,
    93 	    expires => $EXPIRATION,
    91 	    value => { mail => scalar param("mail") },
    94 	    value => { mail => scalar param("mail") },
    92 	});
    95 	});
   105 	    my $time = decrypt($_) or die "DECRYPTION ERROR";
   108 	    my $time = decrypt($_) or die "DECRYPTION ERROR";
   106 	    $time =~ /^\d+$/ or die "FORMAT ERROR";
   109 	    $time =~ /^\d+$/ or die "FORMAT ERROR";
   107 	    time() - $time < (60 * $EXPIRATION) or die "EXPIRED";
   110 	    time() - $time < (60 * $EXPIRATION) or die "EXPIRED";
   108 	};
   111 	};
   109 	if ($@) {
   112 	if ($@) {
   110 	    $tt->process("denied.tpl", {
   113 	    $tt->process("html.denied.tpl", {
   111 		url => $SELF,
   114 		url => $SELF,
   112 	    }) or die $tt->error();
   115 	    }) or die $tt->error();
   113 	    exit 0;
   116 	    exit 0;
   114 	}
   117 	}
   115     }
   118     }
   125 	    confirmed => $confirmed,
   128 	    confirmed => $confirmed,
   126 	}, $sendmail)
   129 	}, $sendmail)
   127 	or die $tt->error();
   130 	or die $tt->error();
   128 	close($sendmail);
   131 	close($sendmail);
   129 
   132 
   130 	$tt->process("confirm.tpl", {
   133 	$tt->process("html.confirm.tpl", {
   131 	    confirmed => $confirmed,
   134 	    confirmed => $confirmed,
   132 	    error => delete $data{error},
   135 	    error => delete $data{error},
   133 	    value => \%data}) or die $tt->error();
   136 	    value => \%data}) or die $tt->error();
   134 	exit 0;
   137 	exit 0;
   135     }
   138     }
   190 	    }, $sendmail)
   193 	    }, $sendmail)
   191 	    or die $tt->error();
   194 	    or die $tt->error();
   192 
   195 
   193 	    close($sendmail);
   196 	    close($sendmail);
   194 
   197 
   195 	    $tt->process("form.ack.tpl", {
   198 	    $tt->process("html.form.ack.tpl", {
   196 		value => \%value,
   199 		value => \%value,
   197 		timestamp => $r{timestamp},
   200 		timestamp => $r{timestamp},
   198 		uuid => $r{uuid},
   201 		uuid => $r{uuid},
   199 	    }) or die $tt->error();
   202 	    }) or die $tt->error();
   200 	    exit 0;
   203 	    exit 0;
   201 	}
   204 	}
   202     }
   205     }
   203 
   206 
   204 
   207 
   205     ## Formular
   208     ## Formular
   206     $tt->process("form.tpl", {
   209     $tt->process("html.form.tpl", {
   207 	warn => %warn ? \%warn : undef,
   210 	warn => %warn ? \%warn : undef,
   208 	value => {
   211 	value => {
   209 	    givenname => scalar param("givenname"),
   212 	    givenname => scalar param("givenname"),
   210 	    surname => scalar param("surname"),
   213 	    surname => scalar param("surname"),
   211 	    mail => scalar param("mail"),
   214 	    mail => scalar param("mail"),
   270 
   273 
   271     return %data;
   274     return %data;
   272 }
   275 }
   273 
   276 
   274 sub read_conf($) {
   277 sub read_conf($) {
   275     open(my $_, $_[0]) or die "Can't open $_[0]: $!\n";
       
   276     local $/ = undef;
   278     local $/ = undef;
       
   279     open(my $f, $_[0]) or die "Can't open $_[0]: $!\n";
       
   280     my $_ = <$f>;
   277     s/^#.*//mg;
   281     s/^#.*//mg;
   278     return <$_>;
   282     /^\s*(.*?)\s*$/s;
   279 }
   283     return $1;
       
   284 }