head	1.2;
access;
symbols
	OPENPKG_E1_MP_HEAD:1.1
	OPENPKG_E1_MP:1.1
	OPENPKG_E1_MP_2_STABLE:1.1.2.2
	OPENPKG_E1_FP:1.1.2.2
	OPENPKG_2_STABLE_MP:1.1
	OPENPKG_2_STABLE_20061018:1.1.2.2
	OPENPKG_2_STABLE:1.1.0.2;
locks; strict;
comment	@# @;


1.2
date	2008.01.01.12.30.53;	author rse;	state dead;
branches;
next	1.1;
commitid	kV7TL7aNQ15B1ILs;

1.1
date	2006.03.07.18.54.51;	author rse;	state Exp;
branches
	1.1.2.1;
next	;
commitid	MbF2aOAV75c9xhor;

1.1.2.1
date	2006.03.07.18.54.51;	author rse;	state dead;
branches;
next	1.1.2.2;
commitid	iZxwRSmmWscPXUQr;

1.1.2.2
date	2006.10.16.14.53.42;	author rse;	state Exp;
branches;
next	;
commitid	iZxwRSmmWscPXUQr;


desc
@@


1.2
log
@Remove packages which will be included in the forthcoming
OpenPKG Framework, maintained by the OpenPKG GmbH according to:
http://www.mail-archive.com/openpkg-announce@@openpkg.org/msg00221.html
@
text
@--- /dev/null	2005-11-27 00:46:14 +0100
+++ ase.pm	2005-11-27 00:47:12 +0100
@@@@ -0,0 +1,503 @@@@
+##
+##  OSSP ase -- Affiliation Service Environment
+##  Copyright (c) 2005 Ralf S. Engelschall <rse@@engelschall.com>
+##  Copyright (c) 2005 The OSSP Project <http://www.ossp.org/>
+##
+##  This file is part of OSSP ase, a service environment for managing
+##  affiliations which can be found at http://www.ossp.org/pkg/tool/ase/.
+##
+##  This program is free software; you can redistribute it and/or modify
+##  it under the terms of the GNU General Public License as published by
+##  the Free Software Foundation; either version 2 of the License, or
+##  (at your option) any later version.
+##
+##  This program is distributed in the hope that it will be useful,
+##  but WITHOUT ANY WARRANTY; without even the implied warranty of
+##  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+##  General Public License for more details.
+##
+##  You should have received a copy of the GNU General Public License
+##  along with this program; if not, write to the Free Software
+##  Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+##  USA, or contact Ralf S. Engelschall <rse@@engelschall.com>.
+##
+##  ase.pm: client API
+##
+
+package OSSP::ase::client;
+
+use 5.008;
+use strict;
+use warnings;
+use base 'Exporter';
+
+our $VERSION = do { my @@v = ('0.0.1' =~ m/\d+/g); sprintf("%d.".("%02d"x$#v), @@v); };
+
+our @@EXPORT_OK = ();
+our @@EXPORT    = ();
+
+#   names of valid ASE session attributes
+my @@valid_attributes = qw(
+    session-id
+    session-valid
+    session-created
+    session-expires
+    canvas-url
+    canvas-mark-head
+    canvas-mark-body
+    client-address
+    client-login-uuid
+    client-login-name
+);
+
+#   textual markers for canvas
+my $canvas_mark = {
+    head => "<!-- ASE: HEAD -->",
+    body => "<!-- ASE: BODY -->"
+};
+
+#   lazy loading of modules
+sub _use ($$) {
+    my ($self, $name) = @@_;
+    if (not defined($self->{-use}->{$name})) {
+        eval "require $name; import $name;";
+        $self->{-use}->{$name} = 1;
+    }
+    return;
+}
+
+#   debugging: time identification
+sub _time () {
+    my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime(time());
+    return sprintf("%04d-%02d-%02d %02d:%02d:%02d", $year, $mon+1, $mday, $hour, $min, $sec);
+}
+
+#   debugging: message formatting
+sub _debug ($$;@@) {
+    my ($self, $fmt, @@args) = @@_;
+
+    return if (not defined($self->{-debug}));
+    if (defined($args[0])) {
+        $self->{-debug}->printf("%s $fmt\n", $self->_time(), @@args);
+    }
+    else {
+        $self->{-debug}->printf("%s %s\n", $self->_time(), $fmt);
+    }
+    return;
+}
+
+#   debugging: structure dumping
+sub _dump ($;@@) {
+    my ($self, $prefix, @@args) = @@_;
+
+    return if (not defined($self->{-debug}));
+    $self->_use("Data::Dumper");
+    my $d = Data::Dumper->new([@@args]);
+    $d->Purity(0);
+    $d->Indent(1);
+    $d->Terse(1);
+    $d->Pad(sprintf("%s %s| ", $self->_time()), $prefix);
+    $self->{-debug}->print($d->Dump());
+    return;
+}
+
+#   object constructor
+sub new {
+    my $proto = shift;
+    my %args = @@_;
+
+    #   create new object
+    my $class = ref($proto) || $proto;
+    my $self = {};
+    bless ($self, $class);
+
+    #   fill object with attributes
+    $self->{-server}   = ($args{-server}  || die "no OSSP ase server URL specified with \"-server\"");
+    $self->{-cgi}      = ($args{-cgi}     || new CGI);
+    $self->{-session}  = ($args{-session} || new CGI::Session);
+    $self->{-mode}     = ($args{-mode}    || "mode");
+    $self->{-valid}    = ($args{-valid}   || 0);
+    $self->{-debug}    = ($args{-debug}   || undef);
+    $self->{-response} = "";
+    $self->{-error}    = "";
+    $self->{-use}      = {};
+
+    #   optionally open debug logfile
+    if (defined($self->{-debug})) {
+        $self->_use("IO::File");
+        $self->{-debug} = IO::File->new(">>" . $self->{-debug})
+            or die "failed to open debug logfile: $!";
+    }
+
+    #   return object
+    return $self;
+}
+
+#   object destructor (explicit)
+sub destroy ($) {
+    my ($self) = @@_;
+
+    #   shutdown sub-objects
+    $self->{-session}->flush() if (defined($self->{-session}));
+    $self->{-debug}->close()   if (defined($self->{-debug}));
+
+    #   destroy sub-objects
+    delete $self->{-cgi};
+    delete $self->{-session};
+    delete $self->{-debug};
+
+    return;
+}
+
+#   object destructor (implicit)
+sub DESTROY ($) {
+    my ($self) = @@_;
+    $self->destroy();
+    return;
+}
+
+#   run-time responsibility check
+sub responsible ($) {
+    my ($self) = @@_;
+
+    my $action = $self->{-cgi}->url_param("ase-action") || "";
+    return $action =~ m/^(login|logout|info|comeback)$/;
+}
+
+#   run-time action handler
+sub action ($;%) {
+    my ($self, %args) = @@_;
+
+    #   debugging
+    $self->_debug("action: client-sid=%s server-sid=%s",
+        $self->{-session}->id(), $self->attr("session-id") || "none");
+
+    my $action = $self->{-cgi}->url_param("ase-action") || "";
+    if ($action =~ m/^(login|logout|info)$/) {
+        #
+        #   request ASE actions
+        #
+        my $mode_during = $self->{-cgi}->url_param("ase-mode-during")
+            or { $self->error("CGI parameter \"ase-mode-during\" missing or empty"), return 0 };
+        my $mode_after  = $self->{-cgi}->url_param("ase-mode-after")
+            or { $self->error("CGI parameter \"ase-mode-after\" missing or empty"), return 0 };
+
+        #   debugging
+        $self->_debug("action: action=%s mode-during=%s mode-after=%s", $action, $mode_during, $mode_after);
+
+        #   remember mode after action
+        $self->attr("mode-after", $mode_after);
+
+        #   determine URLs for canvas and return
+        my $canvas = sprintf("%s?%s=%s",
+            $self->{-cgi}->url(-full => 1), $self->{-mode}, $mode_during);
+        my $return = sprintf("%s?ase-action=comeback;ase-action-old=%s;ase-sid=%%s",
+            $self->{-cgi}->url(-full => 1), $action);
+
+        #   determine URL for server request
+        $self->_use("URI::Escape");
+        my $url = sprintf(
+            "%s?mode=rpc;method=%s;" .
+            "return=%s;canvas=%s;canvas_mark_head=%s;canvas_mark_body=%s",
+            $self->{-server}, $action,
+            URI::Escape::uri_escape($return),
+            URI::Escape::uri_escape($canvas),
+            URI::Escape::uri_escape($canvas_mark->{"head"}),
+            URI::Escape::uri_escape($canvas_mark->{"body"}));
+
+        #   redirect to server request URL
+        $self->response($self->{-cgi}->redirect(-url => $url, -status => 302));
+        return 1;
+    }
+    elsif ($action eq 'comeback') {
+        #
+        #   respond to ASE actions
+        #
+        my $action_old = $self->{-cgi}->url_param("ase-action-old")
+            or { $self->error("CGI parameter \"ase-action-old\" missing or empty"), return 0 };
+        my $sid = $self->{-cgi}->url_param("ase-sid")
+            or { $self->error("CGI parameter \"ase-sid\" missing or empty"), return 0 };
+
+        $self->_debug("action: action=%s action-old=%s sid=%s", $action, $action_old, $sid);
+
+        #   sanity check remote server session
+        $self->attr("session-id", $sid);
+        $self->validate(1);
+        if ($action_old eq "login" and $self->attr("session-valid") ne "yes") {
+            $self->error("server session still invalid after login: \"%s\"", $sid);
+            return 0;
+        }
+        elsif ($action_old eq "logout" and $self->attr("session-valid") ne "no") {
+            $self->error("server session still valid after logout: \"%s\"", $sid);
+            return 0;
+        }
+
+        #   redirect to own following URL
+        my $mode_after = $self->attr("mode-after");
+        my $url = sprintf("%s?%s=%s", $self->{-cgi}->url(-relative => 1), $self->{-mode}, $mode_after);
+        $self->response($self->{-cgi}->redirect(-url => $url, -status => 302));
+        return 1;
+    }
+    else {
+        $self->error("unable to determine action");
+        return 0;
+    }
+}
+
+sub response ($;$) {
+    my ($self, $response) = @@_;
+
+    my $rv = $self->{-response};
+    if (not $rv and $self->error()) {
+        $rv = $self->{-cgi}->header(
+            -status  => "500 Internal Server Error",
+            -type    => "text/plain",
+            -expires => "+0s",
+        ) . "ASE ERROR: " . $self->error() . "\n";
+    }
+    $self->{-response} = $response if (@@_ == 2);
+    return $rv;
+}
+
+sub error ($;$@@) {
+    my ($self, $fmt, @@args) = @@_;
+
+    my $rv = $self->{-error};
+    $self->{-error} = (@@_ >= 3 ? sprintf($fmt, @@args) : sprintf("%s", $fmt)) if (@@_ >= 2);
+    return $rv;
+}
+
+#   session validation
+sub validate ($) {
+    my ($self, $forced) = @@_;
+
+    #   make sure there is a session to be validated
+    my $sid = $self->attr("session-id");
+    return if (not defined($sid));
+
+    #   debugging
+    $self->_debug("METHOD: validate: forced=%s sid=%s", $forced ? "yes" : "no", $sid);
+
+    #   short-circuit if still no (re-)validation is necessary
+    my $valid_since = $self->attr("session-valid-since");
+    return if (    not $forced
+               and defined($valid_since)
+               and (   $self->{-valid} == 0
+                    or ($valid_since + $self->{-valid}) > time()));
+
+    #   clear all remembered session attributes
+    foreach my $key (@@valid_attributes) {
+        $self->attr($key, undef);
+    }
+
+    #   query server for session information
+    $self->_use("IO::Socket::INET");
+    my $server = $self->{-server};
+    my ($host, $port, $path) = ($server =~ m|^http://([^:/]+)((?::\d+)?)(.*)$|) or die;
+    $port ||= 80;
+    $port =~ s|^:||;
+    $path .= "?mode=rpc;method=info;sid=$sid";
+    my $sock = IO::Socket::INET->new (
+        PeerAddr => $host,
+        PeerPort => $port,
+        Proto    => "tcp",
+        Timeout  => 10
+    ) or die "failed to connect to $host:$port: $@@";
+    $sock->autoflush(1);
+    $sock->printf(
+        "GET $path HTTP/1.0\n" .
+        "Host: $host:$port\n" .
+        "\n"
+    );
+    my $response = '';
+    $response .= $_ while (<$sock>);
+    $sock->close();
+    $self->_debug("METHOD: validate: response from %s", $server);
+
+    #   parse session information response
+    my $attribute = {};
+    $response =~ s|^HTTP/1.[01x]\s+200\s+.+?\r?\n\r?\n||s;
+    foreach my $key (@@valid_attributes) {
+        $attribute->{$key} = "";
+        $response =~ s|${key}:[ \t]+([^\r\n]+)\r?\n|$attribute->{$key} = $1, ''|sei;
+    }
+
+    #   check validatity of session
+    my $expires = ($attribute->{"session-expires"} || 0) - time();
+    if (not (    $attribute->{"session-valid"} eq "yes"
+             and $attribute->{"client-login-uuid"} ne ""
+             and $attribute->{"client-login-name"} ne ""
+             and $expires > 0                           )) {
+        $attribute->{"session-valid"}   = "no";
+        $attribute->{"session-expires"} = time()+1;
+        $expires = 1;
+    }
+
+    #   take over session attributes
+    foreach my $key (@@valid_attributes) {
+        $self->attr($key, $attribute->{$key}, sprintf("+%ds", $expires));
+    }
+
+    #   remember time of this validation
+    $self->attr("session-valid-since", time());
+    $self->_dump("validate: ", $self->{-session});
+    return;
+}
+
+#   self-referencing URL generator
+sub url ($%) {
+    my ($self, %args) = @@_;
+
+    #   create self-referencing URL
+    my $base = $self->{-cgi}->url(-relative => 1);
+    $base = '.' if ($base eq '');
+    my $mode =    $self->{-cgi}->url_param($self->{-mode})
+               || $self->{-cgi}->param($self->{-mode})
+               || "";
+    my $url = sprintf(
+        "%s?ase-action=%s;ase-mode-during=%s;ase-mode-after=%s",
+        $base, $args{-action},
+        $args{-mode_during} || $mode,
+        $args{-mode_after}  || $mode
+    );
+
+    return $url;
+}
+
+#   return arbitrary ASE session attributes
+sub attr ($$;$$) {
+    my ($self, $name, $value, $expire) = @@_;
+
+    my $value_old = $self->{-session}->param("ase-$name");
+    if (@@_ >= 3) {
+        if (defined($value)) {
+            $self->{-session}->param("ase-$name", $value);
+            if (defined($expire)) {
+                $self->{-session}->expire("ase-$name", $expire);
+            }
+        }
+        else {
+            $self->{-session}->clear("ase-$name");
+        }
+    }
+    return $value_old;
+}
+
+#   return current login
+sub login ($) {
+    my ($self) = @@_;
+
+    return (($self->attr("session-valid") || "no") eq "yes");
+}
+
+#   return ASE canvas marker for head and body
+sub canvas ($%) {
+    my ($self, %args) = @@_;
+
+    return ( $args{-part} eq 'head'
+            ? $canvas_mark->{"head"}
+            : $canvas_mark->{"body"});
+}
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+OSSP::ase::client -- OSSP ase Client API
+
+=head1 DESCRIPTION
+
+B<OSSP::ase::client> is the client Perl API of B<OSSP ase>.
+It allows an arbitrary CGI written in Perl to leverage from
+B<OSSP ase> authentication.
+
+=head1 APPLICATION PROGRAMMING INTERFACE (API)
+
+The following API methods are provided:
+
+=over 4
+
+=item C<my $ase = >B<new OSSP::ase::client>C<(>I<options>C<);>
+
+This creates a new B<OSSP ase> client object.
+The available I<options> are:
+
+=over 4
+
+=item B<-server> (default: I<none>)
+
+Mandatory URL of the B<OSSP ase> server CGI.
+Usually something like C<http://ase.example.com/ase.cgi>".
+
+=item B<-cgi> (default: C<new CGI>)
+
+Optional but strongly recommended reference to a B<CGI> query object.
+
+=item B<-session> (default: C<new CGI::Session>)
+
+Optional but strongly recommended reference to a B<CGI::Session> session
+handling object.
+
+=item B<-mode> (default: C<"mode">)
+
+Optional name of B<CGI> parameter holding the run-time mode
+dispatching information, i.e., the parameter your application
+uses to decide which application screen/page to display.
+
+=item B<-valid> (default: C<0>)
+
+Optional number of seconds a B<OSSP ase> server session information is
+valid before it is forced to be revalidated. A value of C<0> indicates
+that no revalidation is enforced at all. Nevertheless the B<OSSP ase>
+server session information is automatically expiring after the time
+the server indicated. The revalidated is intended for intermediate
+revalidation.
+
+=back
+
+=item C<$ase-E<gt>destroy();>
+
+=item C<undef $ase;>
+
+This destroys the B<OSSP ase> client object.
+
+=item C<$ase-E<gt>responsible();>
+
+FIXME
+
+=item C<$ase-E<gt>action();>
+
+FIXME
+
+=item C<$ase-E<gt>error();>
+
+FIXME
+
+=item C<$ase-E<gt>response();>
+
+FIXME
+
+=item C<$ase-E<gt>validate($forced);>
+
+FIXME
+
+=item C<$ase-E<gt>url();>
+
+FIXME
+
+=item C<$ase-E<gt>attr($name>[C<, $value>[C<, $expire>]]C<);>
+
+FIXME
+
+=item C<$ase-E<gt>canvas();>
+
+FIXME
+
+=back
+
+=cut
+
@


1.1
log
@flush patch file to CVS and upgrade to latest version
@
text
@@


1.1.2.1
log
@file openpkg-registry.patch was added on branch OPENPKG_2_STABLE on 2006-10-16 14:53:42 +0000
@
text
@d1 506
@


1.1.2.2
log
@Mass merge from CURRENT to 2-STABLE (all packages except those of JUNK class)
@
text
@a0 506
--- /dev/null	2005-11-27 00:46:14 +0100
+++ ase.pm	2005-11-27 00:47:12 +0100
@@@@ -0,0 +1,503 @@@@
+##
+##  OSSP ase -- Affiliation Service Environment
+##  Copyright (c) 2005 Ralf S. Engelschall <rse@@engelschall.com>
+##  Copyright (c) 2005 The OSSP Project <http://www.ossp.org/>
+##
+##  This file is part of OSSP ase, a service environment for managing
+##  affiliations which can be found at http://www.ossp.org/pkg/tool/ase/.
+##
+##  This program is free software; you can redistribute it and/or modify
+##  it under the terms of the GNU General Public License as published by
+##  the Free Software Foundation; either version 2 of the License, or
+##  (at your option) any later version.
+##
+##  This program is distributed in the hope that it will be useful,
+##  but WITHOUT ANY WARRANTY; without even the implied warranty of
+##  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+##  General Public License for more details.
+##
+##  You should have received a copy of the GNU General Public License
+##  along with this program; if not, write to the Free Software
+##  Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+##  USA, or contact Ralf S. Engelschall <rse@@engelschall.com>.
+##
+##  ase.pm: client API
+##
+
+package OSSP::ase::client;
+
+use 5.008;
+use strict;
+use warnings;
+use base 'Exporter';
+
+our $VERSION = do { my @@v = ('0.0.1' =~ m/\d+/g); sprintf("%d.".("%02d"x$#v), @@v); };
+
+our @@EXPORT_OK = ();
+our @@EXPORT    = ();
+
+#   names of valid ASE session attributes
+my @@valid_attributes = qw(
+    session-id
+    session-valid
+    session-created
+    session-expires
+    canvas-url
+    canvas-mark-head
+    canvas-mark-body
+    client-address
+    client-login-uuid
+    client-login-name
+);
+
+#   textual markers for canvas
+my $canvas_mark = {
+    head => "<!-- ASE: HEAD -->",
+    body => "<!-- ASE: BODY -->"
+};
+
+#   lazy loading of modules
+sub _use ($$) {
+    my ($self, $name) = @@_;
+    if (not defined($self->{-use}->{$name})) {
+        eval "require $name; import $name;";
+        $self->{-use}->{$name} = 1;
+    }
+    return;
+}
+
+#   debugging: time identification
+sub _time () {
+    my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime(time());
+    return sprintf("%04d-%02d-%02d %02d:%02d:%02d", $year, $mon+1, $mday, $hour, $min, $sec);
+}
+
+#   debugging: message formatting
+sub _debug ($$;@@) {
+    my ($self, $fmt, @@args) = @@_;
+
+    return if (not defined($self->{-debug}));
+    if (defined($args[0])) {
+        $self->{-debug}->printf("%s $fmt\n", $self->_time(), @@args);
+    }
+    else {
+        $self->{-debug}->printf("%s %s\n", $self->_time(), $fmt);
+    }
+    return;
+}
+
+#   debugging: structure dumping
+sub _dump ($;@@) {
+    my ($self, $prefix, @@args) = @@_;
+
+    return if (not defined($self->{-debug}));
+    $self->_use("Data::Dumper");
+    my $d = Data::Dumper->new([@@args]);
+    $d->Purity(0);
+    $d->Indent(1);
+    $d->Terse(1);
+    $d->Pad(sprintf("%s %s| ", $self->_time()), $prefix);
+    $self->{-debug}->print($d->Dump());
+    return;
+}
+
+#   object constructor
+sub new {
+    my $proto = shift;
+    my %args = @@_;
+
+    #   create new object
+    my $class = ref($proto) || $proto;
+    my $self = {};
+    bless ($self, $class);
+
+    #   fill object with attributes
+    $self->{-server}   = ($args{-server}  || die "no OSSP ase server URL specified with \"-server\"");
+    $self->{-cgi}      = ($args{-cgi}     || new CGI);
+    $self->{-session}  = ($args{-session} || new CGI::Session);
+    $self->{-mode}     = ($args{-mode}    || "mode");
+    $self->{-valid}    = ($args{-valid}   || 0);
+    $self->{-debug}    = ($args{-debug}   || undef);
+    $self->{-response} = "";
+    $self->{-error}    = "";
+    $self->{-use}      = {};
+
+    #   optionally open debug logfile
+    if (defined($self->{-debug})) {
+        $self->_use("IO::File");
+        $self->{-debug} = IO::File->new(">>" . $self->{-debug})
+            or die "failed to open debug logfile: $!";
+    }
+
+    #   return object
+    return $self;
+}
+
+#   object destructor (explicit)
+sub destroy ($) {
+    my ($self) = @@_;
+
+    #   shutdown sub-objects
+    $self->{-session}->flush() if (defined($self->{-session}));
+    $self->{-debug}->close()   if (defined($self->{-debug}));
+
+    #   destroy sub-objects
+    delete $self->{-cgi};
+    delete $self->{-session};
+    delete $self->{-debug};
+
+    return;
+}
+
+#   object destructor (implicit)
+sub DESTROY ($) {
+    my ($self) = @@_;
+    $self->destroy();
+    return;
+}
+
+#   run-time responsibility check
+sub responsible ($) {
+    my ($self) = @@_;
+
+    my $action = $self->{-cgi}->url_param("ase-action") || "";
+    return $action =~ m/^(login|logout|info|comeback)$/;
+}
+
+#   run-time action handler
+sub action ($;%) {
+    my ($self, %args) = @@_;
+
+    #   debugging
+    $self->_debug("action: client-sid=%s server-sid=%s",
+        $self->{-session}->id(), $self->attr("session-id") || "none");
+
+    my $action = $self->{-cgi}->url_param("ase-action") || "";
+    if ($action =~ m/^(login|logout|info)$/) {
+        #
+        #   request ASE actions
+        #
+        my $mode_during = $self->{-cgi}->url_param("ase-mode-during")
+            or { $self->error("CGI parameter \"ase-mode-during\" missing or empty"), return 0 };
+        my $mode_after  = $self->{-cgi}->url_param("ase-mode-after")
+            or { $self->error("CGI parameter \"ase-mode-after\" missing or empty"), return 0 };
+
+        #   debugging
+        $self->_debug("action: action=%s mode-during=%s mode-after=%s", $action, $mode_during, $mode_after);
+
+        #   remember mode after action
+        $self->attr("mode-after", $mode_after);
+
+        #   determine URLs for canvas and return
+        my $canvas = sprintf("%s?%s=%s",
+            $self->{-cgi}->url(-full => 1), $self->{-mode}, $mode_during);
+        my $return = sprintf("%s?ase-action=comeback;ase-action-old=%s;ase-sid=%%s",
+            $self->{-cgi}->url(-full => 1), $action);
+
+        #   determine URL for server request
+        $self->_use("URI::Escape");
+        my $url = sprintf(
+            "%s?mode=rpc;method=%s;" .
+            "return=%s;canvas=%s;canvas_mark_head=%s;canvas_mark_body=%s",
+            $self->{-server}, $action,
+            URI::Escape::uri_escape($return),
+            URI::Escape::uri_escape($canvas),
+            URI::Escape::uri_escape($canvas_mark->{"head"}),
+            URI::Escape::uri_escape($canvas_mark->{"body"}));
+
+        #   redirect to server request URL
+        $self->response($self->{-cgi}->redirect(-url => $url, -status => 302));
+        return 1;
+    }
+    elsif ($action eq 'comeback') {
+        #
+        #   respond to ASE actions
+        #
+        my $action_old = $self->{-cgi}->url_param("ase-action-old")
+            or { $self->error("CGI parameter \"ase-action-old\" missing or empty"), return 0 };
+        my $sid = $self->{-cgi}->url_param("ase-sid")
+            or { $self->error("CGI parameter \"ase-sid\" missing or empty"), return 0 };
+
+        $self->_debug("action: action=%s action-old=%s sid=%s", $action, $action_old, $sid);
+
+        #   sanity check remote server session
+        $self->attr("session-id", $sid);
+        $self->validate(1);
+        if ($action_old eq "login" and $self->attr("session-valid") ne "yes") {
+            $self->error("server session still invalid after login: \"%s\"", $sid);
+            return 0;
+        }
+        elsif ($action_old eq "logout" and $self->attr("session-valid") ne "no") {
+            $self->error("server session still valid after logout: \"%s\"", $sid);
+            return 0;
+        }
+
+        #   redirect to own following URL
+        my $mode_after = $self->attr("mode-after");
+        my $url = sprintf("%s?%s=%s", $self->{-cgi}->url(-relative => 1), $self->{-mode}, $mode_after);
+        $self->response($self->{-cgi}->redirect(-url => $url, -status => 302));
+        return 1;
+    }
+    else {
+        $self->error("unable to determine action");
+        return 0;
+    }
+}
+
+sub response ($;$) {
+    my ($self, $response) = @@_;
+
+    my $rv = $self->{-response};
+    if (not $rv and $self->error()) {
+        $rv = $self->{-cgi}->header(
+            -status  => "500 Internal Server Error",
+            -type    => "text/plain",
+            -expires => "+0s",
+        ) . "ASE ERROR: " . $self->error() . "\n";
+    }
+    $self->{-response} = $response if (@@_ == 2);
+    return $rv;
+}
+
+sub error ($;$@@) {
+    my ($self, $fmt, @@args) = @@_;
+
+    my $rv = $self->{-error};
+    $self->{-error} = (@@_ >= 3 ? sprintf($fmt, @@args) : sprintf("%s", $fmt)) if (@@_ >= 2);
+    return $rv;
+}
+
+#   session validation
+sub validate ($) {
+    my ($self, $forced) = @@_;
+
+    #   make sure there is a session to be validated
+    my $sid = $self->attr("session-id");
+    return if (not defined($sid));
+
+    #   debugging
+    $self->_debug("METHOD: validate: forced=%s sid=%s", $forced ? "yes" : "no", $sid);
+
+    #   short-circuit if still no (re-)validation is necessary
+    my $valid_since = $self->attr("session-valid-since");
+    return if (    not $forced
+               and defined($valid_since)
+               and (   $self->{-valid} == 0
+                    or ($valid_since + $self->{-valid}) > time()));
+
+    #   clear all remembered session attributes
+    foreach my $key (@@valid_attributes) {
+        $self->attr($key, undef);
+    }
+
+    #   query server for session information
+    $self->_use("IO::Socket::INET");
+    my $server = $self->{-server};
+    my ($host, $port, $path) = ($server =~ m|^http://([^:/]+)((?::\d+)?)(.*)$|) or die;
+    $port ||= 80;
+    $port =~ s|^:||;
+    $path .= "?mode=rpc;method=info;sid=$sid";
+    my $sock = IO::Socket::INET->new (
+        PeerAddr => $host,
+        PeerPort => $port,
+        Proto    => "tcp",
+        Timeout  => 10
+    ) or die "failed to connect to $host:$port: $@@";
+    $sock->autoflush(1);
+    $sock->printf(
+        "GET $path HTTP/1.0\n" .
+        "Host: $host:$port\n" .
+        "\n"
+    );
+    my $response = '';
+    $response .= $_ while (<$sock>);
+    $sock->close();
+    $self->_debug("METHOD: validate: response from %s", $server);
+
+    #   parse session information response
+    my $attribute = {};
+    $response =~ s|^HTTP/1.[01x]\s+200\s+.+?\r?\n\r?\n||s;
+    foreach my $key (@@valid_attributes) {
+        $attribute->{$key} = "";
+        $response =~ s|${key}:[ \t]+([^\r\n]+)\r?\n|$attribute->{$key} = $1, ''|sei;
+    }
+
+    #   check validatity of session
+    my $expires = ($attribute->{"session-expires"} || 0) - time();
+    if (not (    $attribute->{"session-valid"} eq "yes"
+             and $attribute->{"client-login-uuid"} ne ""
+             and $attribute->{"client-login-name"} ne ""
+             and $expires > 0                           )) {
+        $attribute->{"session-valid"}   = "no";
+        $attribute->{"session-expires"} = time()+1;
+        $expires = 1;
+    }
+
+    #   take over session attributes
+    foreach my $key (@@valid_attributes) {
+        $self->attr($key, $attribute->{$key}, sprintf("+%ds", $expires));
+    }
+
+    #   remember time of this validation
+    $self->attr("session-valid-since", time());
+    $self->_dump("validate: ", $self->{-session});
+    return;
+}
+
+#   self-referencing URL generator
+sub url ($%) {
+    my ($self, %args) = @@_;
+
+    #   create self-referencing URL
+    my $base = $self->{-cgi}->url(-relative => 1);
+    $base = '.' if ($base eq '');
+    my $mode =    $self->{-cgi}->url_param($self->{-mode})
+               || $self->{-cgi}->param($self->{-mode})
+               || "";
+    my $url = sprintf(
+        "%s?ase-action=%s;ase-mode-during=%s;ase-mode-after=%s",
+        $base, $args{-action},
+        $args{-mode_during} || $mode,
+        $args{-mode_after}  || $mode
+    );
+
+    return $url;
+}
+
+#   return arbitrary ASE session attributes
+sub attr ($$;$$) {
+    my ($self, $name, $value, $expire) = @@_;
+
+    my $value_old = $self->{-session}->param("ase-$name");
+    if (@@_ >= 3) {
+        if (defined($value)) {
+            $self->{-session}->param("ase-$name", $value);
+            if (defined($expire)) {
+                $self->{-session}->expire("ase-$name", $expire);
+            }
+        }
+        else {
+            $self->{-session}->clear("ase-$name");
+        }
+    }
+    return $value_old;
+}
+
+#   return current login
+sub login ($) {
+    my ($self) = @@_;
+
+    return (($self->attr("session-valid") || "no") eq "yes");
+}
+
+#   return ASE canvas marker for head and body
+sub canvas ($%) {
+    my ($self, %args) = @@_;
+
+    return ( $args{-part} eq 'head'
+            ? $canvas_mark->{"head"}
+            : $canvas_mark->{"body"});
+}
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+OSSP::ase::client -- OSSP ase Client API
+
+=head1 DESCRIPTION
+
+B<OSSP::ase::client> is the client Perl API of B<OSSP ase>.
+It allows an arbitrary CGI written in Perl to leverage from
+B<OSSP ase> authentication.
+
+=head1 APPLICATION PROGRAMMING INTERFACE (API)
+
+The following API methods are provided:
+
+=over 4
+
+=item C<my $ase = >B<new OSSP::ase::client>C<(>I<options>C<);>
+
+This creates a new B<OSSP ase> client object.
+The available I<options> are:
+
+=over 4
+
+=item B<-server> (default: I<none>)
+
+Mandatory URL of the B<OSSP ase> server CGI.
+Usually something like C<http://ase.example.com/ase.cgi>".
+
+=item B<-cgi> (default: C<new CGI>)
+
+Optional but strongly recommended reference to a B<CGI> query object.
+
+=item B<-session> (default: C<new CGI::Session>)
+
+Optional but strongly recommended reference to a B<CGI::Session> session
+handling object.
+
+=item B<-mode> (default: C<"mode">)
+
+Optional name of B<CGI> parameter holding the run-time mode
+dispatching information, i.e., the parameter your application
+uses to decide which application screen/page to display.
+
+=item B<-valid> (default: C<0>)
+
+Optional number of seconds a B<OSSP ase> server session information is
+valid before it is forced to be revalidated. A value of C<0> indicates
+that no revalidation is enforced at all. Nevertheless the B<OSSP ase>
+server session information is automatically expiring after the time
+the server indicated. The revalidated is intended for intermediate
+revalidation.
+
+=back
+
+=item C<$ase-E<gt>destroy();>
+
+=item C<undef $ase;>
+
+This destroys the B<OSSP ase> client object.
+
+=item C<$ase-E<gt>responsible();>
+
+FIXME
+
+=item C<$ase-E<gt>action();>
+
+FIXME
+
+=item C<$ase-E<gt>error();>
+
+FIXME
+
+=item C<$ase-E<gt>response();>
+
+FIXME
+
+=item C<$ase-E<gt>validate($forced);>
+
+FIXME
+
+=item C<$ase-E<gt>url();>
+
+FIXME
+
+=item C<$ase-E<gt>attr($name>[C<, $value>[C<, $expire>]]C<);>
+
+FIXME
+
+=item C<$ase-E<gt>canvas();>
+
+FIXME
+
+=back
+
+=cut
+
@