#!/usr/local/bin/perl
# Copyright (c) 2006 Sampo Kellomaki (sampo@iki.fi), All Rights Reserved.
# This is confidential unpublished proprietary source code of the author.
# NO WARRANTY, not even implied warranties. Contains trade secrets.
# Distribution prohibited unless authorized in writing. See file COPYING.
# $Id: zxid.pl,v 1.2 2006/09/05 05:09:37 sampo Exp $
# 31.8.2006, created --Sampo

use Net::SAML;
use Data::Dumper;

$| = 1;

$cf = Net::SAML::new_conf("/var/zxid/");
$url = "https://sp1.zxidsp.org:8443/zxid.pl";
Net::SAML::url_set($cf, $url);
Net::SAML::set_opt($cf, 1 ,1);  # Turn on libzxid level debugging
$cgi = Net::SAML::new_cgi($cf, $ENV{'QUERY_STRING'});
$op = Net::SAML::zxid_cgi::swig_op_get($cgi);
warn "op($op)";
if ($op eq 'P') {
    $qs = <STDIN>;
    warn "post input($qs)";
    Net::SAML::parse_cgi($cgi, $qs);
    $op = Net::SAML::zxid_cgi::swig_op_get($cgi);
}
$op ||= 'M';

$sid = Net::SAML::zxid_cgi::swig_sid_get($cgi)
    and $ses = Net::SAML::fetch_ses($cf, $sid)
    and mgmt_screen($cf, $cgi, $ses, $op)
    and exit;
$ses = Net::SAML::fetch_ses($cf, "");  # Just allocate an empty one

warn "Not logged in case op($op) ses($ses)";

### Not logged in case

if ($op eq 'M') {       # Invoke LECP or redirect to CDC reader.
    exit if Net::SAML::lecp_check($cf, $cgi);
    printf "Location: %s?o=C\r\n\r\n", NET::SAML::CDC_URL;
    exit;
} elsif ($op eq 'C') {  # CDC Read: Common Domain Cookie Reader
    &Net::SAML::cdc_read($cf, $cgi);
    exit;
} elsif ($op eq 'E') {  # Return from CDC read, or start here to by-pass CDC read.
    exit if Net::SAML::lecp_check($cf, $cgi);
    exit if Net::SAML::cdc_check($cf, $cgi);
} elsif ($op eq 'L') {
    warn "Start login";
    $url = Net::SAML::start_sso_url($cf, $cgi);
    if ($url) {
	$url_len = Net::SAML::zx_str_s::swig_len_get($url);
	$url = substr(Net::SAML::zx_str_s::swig_s_get($url), 0, $url_len);
	print "Location: $url\r\n\r\n";
	exit;
    }
    warn "Login trouble";
} elsif ($op eq 'A') {
    $ret = Net::SAML::sp_deref_art($cf, $cgi, $ses);
    warn "deref art ret($ret)";
    exit if $ret == NET::SAML::REDIR_OK;
    if ($ret = NET::SAML::SSO_OK) {
	exit if mgmt_screen($cf, $cgi, $ses, $op);
    }
} elsif ($op eq 'P') {
    $ret = Net::SAML::sp_dispatch($cf, $cgi, $ses, Net::SAML::zxid_cgi::swig_saml_resp_get($cgi));
    warn "saml_resp ret($ret)";
    exit if $ret == NET::SAML::REDIR_OK;
    if ($ret = NET::SAML::SSO_OK) {
	exit if mgmt_screen($cf, $cgi, $ses, $op);
    }
} elsif ($op eq 'Q') {
    $ret = Net::SAML::sp_dispatch($cf, $cgi, $ses, Net::SAML::zxid_cgi::swig_saml_req_get($cgi));
    exit if $ret == NET::SAML::REDIR_OK;
    if ($ret = NET::SAML::SSO_OK) {
	exit if mgmt_screen($cf, $cgi, $ses, $op);
    }
} elsif ($op eq 'B') {
    print "CONTENT-TYPE: text/xml\r\n\r\n";
    Net::SAML::send_sp_meta($cf, $cgi);
    exit;
} else {
    die "Unknown op($op)";
}

print <<HTML;
CONTENT-TYPE: text/html

<title>ZXID SP PERL SSO</title>
<body bgcolor="#330033" text="#ffaaff" link="#ffddff" vlink="#aa44aa" alink="#ffffff"><font face=sans><h1>ZXID SP Perl Federated SSO (user NOT logged in, no session.)</h1><pre>
</pre><form method=post action="zxid.pl?o=P">

<h3>Login Using New IdP</h3>

<i>A new IdP is one whose metadata we do not have yet. We need to know
the Entity ID in oredr to fetch the metadata using the well known
location method. You will need to ask the adiminstrator of the IdP to
tell you what the EntityID is.</i>

<p>IdP EntityID URL <input name=e size=100>
<input type=submit name=l1 value=" Login (SAML20:Artifact) ">
<input type=submit name=l2 value=" Login (SAML20:POST) ">

HTML
    ;

$idp = Net::SAML::load_cot_cache($cf);
if ($idp) {
    print "<h3>Login Using Known IdP</h3>\n";
    while ($idp) {
	$eid = Net::SAML::zxid_entity::swig_eid_get($idp);
	$eid_len = Net::SAML::zxid_entity::swig_eid_len_get($idp);
	$eid = substr($eid, 0, $eid_len);
	warn "eid_len($eid_len) eid($eid)";
	print <<HTML;
<input type=submit name="l1$eid" value=" Login to $eid (SAML20:Artifact) ">
<input type=submit name="l2$eid" value=" Login to $eid (SAML20:POST) ">
HTML
;
	$idp = Net::SAML::zxid_entity::swig_n_get($idp);
    }
}

print <<HTML;
<h3>CoT configuration parameters your IdP may need to know</h3>

Entity ID of this SP: <a href="$url?o=B">$url?o=B</a> (Click on the link to fetch SP metadata.)

<h3>Technical options (typically hidden fields on production site)</h3>

<input type=checkbox name=fc value=1 checked> Allow new federation to be created<br>
<input type=checkbox name=fp value=1> Do not allow IdP to interact (e.g. ask password) (IsPassive flag)<br>
<input type=checkbox name=ff value=1> IdP should reauthenticate user (ForceAuthn flag)<br>
NID Format: <select name=fn><option value=prstnt>Persistent<option value=trnsnt>Transient<option value="">(none)</select><br>
Affiliation: <select name=fq><option value="">(none)</select><br>

Consent: <select name=fy><option value="">(empty)
<option value="urn:liberty:consent:obtained">obtained
<option value="urn:liberty:consent:obtained:prior">obtained:prior
<option value="urn:liberty:consent:obtained:current:implicit">obtained:current:implicit
<option value="urn:liberty:consent:obtained:current:explicit">obtained:current:explicit
<option value="urn:liberty:consent:unavailable">unavailable
<option value="urn:liberty:consent:inapplicable">inapplicable
</select><br>
Authn Req Context: <select name=fa><option value="">(none)
<option value=pw>Password
<option value=pwp>Password with Protected Transport
<option value=clicert>TLS Client Certificate</select><br>
Matching Rule: <select name=fm><option value=exact>Exact
<option value=minimum>Min
<option value=maximum>Max
<option value=better>Better
<option value="">(none)</select><br>

</form><hr><a href="http://zxid.org/">zxid.org</a>, 0.3 libzxid (zxid.org)
HTML
    ;

### Logged in case

sub mgmt_screen {
    my ($cf, $cgi, $ses, $op) = @_;
    warn "mgmt op($op)";
    if ($op eq 'l') {
	Net::SAML::del_ses($cf, $ses);
	$msg = "Local logout Ok. Session terminated.";
	return 0;  # Simply abandon local session. Falls thru to login screen.
    } elsif ($op eq 'r') {
	Net::SAML::sp_slo_redir($cf, $cgi, $ses);
	Net::SAML::del_ses($cf, $ses);
	return 1;  # Redirect already happened. Do not show login screen.
    } elsif ($op eq 's') {
	Net::SAML::sp_slo_soap($cf, $cgi, $ses);
	Net::SAML::del_ses($cf, $ses);
	$msg = "SP Initiated logout (SOAP). Session terminated.";
	return 0;  # Falls thru to login screen.
    } elsif ($op eq 't') {
	Net::SAML::sp_nireg_redir($cf, $cgi, $ses, 0);
	return 1;  # Redirect already happened. Do not show login screen.
    } elsif ($op eq 'u') {
	Net::SAML::sp_nireg_soap($cf, $cgi, $ses, 0);
	$msg = "SP Initiated defederation (SOAP).";
    } elsif ($op eq 'P') {
	$ret = Net::SAML::sp_dispatch($cf, $cgi, $ses, Net::SAML::zxid_cgi::swig_saml_resp_get($cgi));
	return 0 if $ret == Net::SAML::OK;
	return 1 if $ret == Net::SAML::REDIR_OK;
    } elsif ($op eq 'Q') {
	$ret = Net::SAML::sp_dispatch($cf, $cgi, $ses, Net::SAML::zxid_cgi::swig_saml_req_get($cgi));
	return 0 if $ret == Net::SAML::OK;
	return 1 if $ret == Net::SAML::REDIR_OK;
    }

    $sid = Net::SAML::zxid_ses::swig_sid_get($ses);
    $nid = Net::SAML::zxid_ses::swig_nid_get($ses);

    #printf("COOKIE: foo\r\n");
    print <<HTML;
CONTENT-TYPE: text/html

<title>ZXID SP Mgmt</title><body bgcolor="#330033" text="#ffaaff" link="#ffddff" vlink="#aa44aa" alink="#ffffff"><font face=sans>

<h1>ZXID SP Perl Management (user logged in, session active)</h1><pre>
</pre><form method=post action="zxid.pl?o=P">
<input type=hidden name=s value="$sid">
<input type=submit name=gl value=" Local Logout ">
<input type=submit name=gr value=" Single Logout (Redir) ">
<input type=submit name=gs value=" Single Logout (SOAP) ">
<input type=submit name=gt value=" Defederate (Redir) ">
<input type=submit name=gu value=" Defederate (SOAP) ">

<h3>Technical options (typically hidden fields on production site)</h3>
  
sid($sid) nid($nid) <a href="zxid.pl?s=%s">Reload</a>

</form><hr>
<a href="http://zxid.org/">zxid.org</a>
HTML
;
  return 1;
}

__EOF__
