...
use constant SESSION_TIME => '60000'; #ms
...
# ---- CGI
my $cgi = CGI->new();
my $query = $cgi->Vars();
# ---- SETTINGS
my %subs = ();
$subs{relative_url} = $cgi->url(-relative=>1);
$subs{full_url}     = $cgi->url(-full=>1);
...
print $cgi->header(-charset=>'ISO-8859-1',
                   -expires=>'+1s',
                   -type=>'text/html',
                   );

if( (exists $query->{sid})                                                      # wenn session existiert
and validate_session( $query->{sid} ) ){                                          # und gültig ist
        #session verlängern
        $query->{sid} = time() . "XY" . (split /XY/, $query->{sid})[1];
        #settings
        $subs{self} = $subs{relative_url} . '?sid=' . $query->{sid} . '&file=' . $query->{file};
        $subs{query} = '?sid=' . $query->{sid} . '&file=' . $query->{file};
        $subs{domain} = "http://" . DOMAIN;
        $subs{sid} = $query->{sid};
        $subs{file} = $query->{file};
...
}else{ #wenn keine session existiert / session nicht gültig ist
        if( exists $query->{action}
        and $query->{action} eq "login"
        and main::validate_login($query->{usn}, $query->{pwd}) ){
            $query->{sid} = time() . "XY" . rand(1);
            $query->{sid} =~ s/\./PT/g;
            #settings
            $subs{self} = $subs{relative_url} . '?sid=' . $query->{sid} . '&file=' . $query->{file};
            $subs{query} = '?sid=' . $query->{sid} . '&file=' . $query->{file};
            $subs{domain} = "http://" . DOMAIN;
            # erstes einloggen => INDEX
            print qq~<h1>Login korrekt!</h1>~;
            print qq~<p><a href="$subs{self}">weiter &gt;&gt;&gt;</a></p>~;
            print qq~<p>SID: $query->{sid}</p>~;
            print qq~<p>file: $query->{file}</p>~;
        }else{
            print $loginForm;
        }
}
exit( 1 );
...
# --------------------------------------------------------
# SUBS
# --------------------------------------------------------
sub validate_login{
# ---- usage
# if( validate_login( $query->{usn}, $query->{pwd} ) ){ print "Login ok!\n"; }
# ---- requirements
# modul: Crypt::PasswdMD5
# $passfile -> File mit USN|PWD(cryptedBy: Crypt::PasswdMD5)\n
    my ($usn, $pwd) = @_;
    my $return = 0;
    open(DAT, $passfile) || die "$! ($passfile)";
    flock DAT, 1 if UNIX;
    my @passfile = <DAT>;
    close(DAT);
    foreach ( @passfile ){
        chomp $_;
        if( $usn eq (split /\|/,$_)[0] ){
            if (unix_md5_crypt($pwd, (split /\|/,$_)[1])
               eq (split /\|/,$_)[1] ) {
                # Passwort in Ordnung
                $return = 1;
            }else{
                $return = 0;
            }
        }else{
            $return = 0;
        }
    }
    return $return;
}
# --------------------------------------------------------
sub validate_session{
# ---- usage
# if( validate_session( $sessionDataToValidate ) ){ print "Session Ok!\n"; }
# ----
# prüfen, ob gültige sid: a)muster b)haltbarkeit
    my $session = $_[0];
    my $return = 0;
    if( $session =~ /\d{10}XY\d*PT\d{10}/
    and (split /XY/, $session)[0] > time() - SESSION_TIME ){
            $return = 1;
    }
    return $return;
}
# --------------------------------------------------------