#!/usr/local/bin/perl -w
# cgi-s-roaming.pl -- Zustandserhaltung mit serverseitiger Speicherung
#               und Benutzerauthentifikation. Roaming-User.

use strict;
use CGI qw(:standard);
use CGI::Carp qw(fatalsToBrowser);
use Tie::RDBM;
use Math::TrulyRandom;

use constant INITSTATE => 1;

use constant STATEDSN  => 'dbi:mysql:database=www';
use constant STATEUSER => 'nobody';
use constant STATEPASS => 'wwwpass';
use constant STATETBL  => 'statesessions';

# Wir brechen ab, wenn wir ohne Authentifikation aufgerufen wurden.
# Das sollte nur passieren, wenn wir dieses Skript ausserhalb des
# durch z.B. Apache::AuthenDBI geschuetzten valid-user-Bereichs haetten.
die "The Webserver didn't authenticate a user!"
    unless defined $ENV{'REMOTE_USER'};

my  %sql;
tie %sql, 'Tie::RDBM', STATEDSN,
          { user  => STATEUSER, password => STATEPASS,
            table => STATETBL,  create => 1 }
    or die "can't tie: $!\n";

my $state      = retrieve_state();
my $nextstate  = compute_next_state($state);
my $thestate   = save_state($nextstate);

# Tue etwas abhaengig von $state:
print header(),
    start_html('State for roaming users'),
    "Current state: ", $thestate->{'STATE'}, p,
    "If you call me again, I'll increment it for you",
    end_html;

sub retrieve_state {
    my $SVL = INITSTATE;
    my $U   = "u_$ENV{'REMOTE_USER'}";
    my $SID = $sql{$U};

    if (defined $SID) {
        # Datenbank gibt eine Session-ID vor:
    $SVL = $sql{$SID} || die "Sorry, should not happen: $SID!\n";
    } else {
    # Das ist eine neue Sitzung!
    tied(%sql)->{'dbh'}->do("LOCK TABLES " . STATETBL . " WRITE");
        die "$DBI::errstr" if $DBI::err;

          # Um Race Conditions zu vermeiden, laeuft das folgende in
          # einer Transaktion bzw. bei gesperrten Tabellen (MySQL) ab.
      do { $SID = truly_random_value() } while exists $sql{$SID};
      $sql{$U}   = $SID;
      $sql{$SID} = $SVL;
      die "Error: $DBI::errstr\n" if $DBI::err;

    tied(%sql)->{'dbh'}->do("UNLOCK TABLES ");
    die "$DBI::errstr" if $DBI::err;
    }

    # Den Zustand mit der zugehoerigen Sitzungs-ID zurueckgeben.
    return { SESSION => $SID, STATE => $SVL };
}

sub compute_next_state {
    my $current_state = shift;
    $current_state->{'STATE'} = $current_state->{'STATE'} + 1;
    return $current_state;
}

sub save_state {
    my $newstate      = shift;

    # Den Zustand serverseitig speichern:
    $sql{$newstate->{'SESSION'}} = $newstate->{'STATE'};

    return $newstate;
}