1#!/usr/local/bin/perl
2# Copyright (c) 2006-2007 Symlabs (symlabs@symlabs.com), All Rights Reserved.
3# Author: Sampo Kellomaki (sampo@iki.fi)
4# This is confidential unpublished proprietary source code of the author.
5# NO WARRANTY, not even implied warranties. Contains trade secrets.
6# Distribution prohibited unless authorized in writing.
7# Licensed under Apache License 2.0, see file COPYING.
8# $Id: zxid.pl,v 1.10 2009-08-30 15:09:26 sampo Exp $
9# 31.8.2006, created --Sampo
10
11use Net::SAML;
12use Data::Dumper;
13
14$| = 1;
15
16open STDERR, ">>tmp/zxid.stderr";   # Helps CGI debugging where web server eats the stderr
17
18$cf = Net::SAML::new_conf("/var/zxid/");
19$url = "https://sp1.zxidsp.org:8443/zxid.pl";
20$cdc_url = "https://sp1.zxidcommon.org:8443/zxid.pl"; # NET::SAML::CDC_URL
21Net::SAML::url_set($cf, $url);
22Net::SAML::set_opt($cf, 1 ,1);  # Turn on libzxid level debugging
23$cgi = Net::SAML::new_cgi($cf, $ENV{'QUERY_STRING'});
24$op = Net::SAML::zxid_cgi::swig_op_get($cgi);
25warn "op($op)";
26if ($op eq 'P') {
27    $qs = <STDIN>;
28    warn "post input($qs)";
29    Net::SAML::parse_cgi($cgi, $qs);
30    $op = Net::SAML::zxid_cgi::swig_op_get($cgi);
31}
32$op ||= 'M';
33
34$sid = Net::SAML::zxid_cgi::swig_sid_get($cgi)
35    and $ses = Net::SAML::fetch_ses($cf, $sid)
36    and mgmt_screen($cf, $cgi, $ses, $op)
37    and exit;
38$ses = Net::SAML::fetch_ses($cf, "");  # Just allocate an empty one
39
40warn "Not logged in case op($op) ses($ses)";
41
42### Not logged in case
43
44if ($op eq 'M') {       # Invoke LECP or redirect to CDC reader.
45    exit if Net::SAML::lecp_check($cf, $cgi);
46    print "Location: $cdc_url?o=C\r\n\r\n";
47    exit;
48} elsif ($op eq 'C') {  # CDC Read: Common Domain Cookie Reader
49    &Net::SAML::cdc_read($cf, $cgi);
50    exit;
51} elsif ($op eq 'E') {  # Return from CDC read, or start here to by-pass CDC read.
52    #exit if Net::SAML::lecp_check($cf, $cgi);
53    exit if Net::SAML::cdc_check($cf, $cgi);
54} elsif ($op eq 'L') {
55    warn "Start login";
56    $url = Net::SAML::start_sso_url($cf, $cgi);
57    if ($url) {
58	warn "Start SSO redirect($url)";
59	print "Location: $url\r\n\r\n";
60	exit;
61    }
62    warn "Login trouble ($url)";
63} elsif ($op eq 'A') {
64    $ret = Net::SAML::sp_deref_art($cf, $cgi, $ses);
65    warn "deref art ret($ret)";
66    exit if $ret == 2;
67    if ($ret == 3) {
68	exit if mgmt_screen($cf, $cgi, $ses, $op);
69    }
70} elsif ($op eq 'P') {
71    $ret = Net::SAML::sp_dispatch($cf, $cgi, $ses, Net::SAML::zxid_cgi::swig_saml_resp_get($cgi));
72    warn "saml_resp ret($ret)";
73    exit if $ret == 2;
74    if ($ret == 3) {
75	exit if mgmt_screen($cf, $cgi, $ses, $op);
76    }
77} elsif ($op eq 'Q') {
78    $ret = Net::SAML::sp_dispatch($cf, $cgi, $ses, Net::SAML::zxid_cgi::swig_saml_req_get($cgi));
79    exit if $ret == 2;
80    if ($ret == 3) {
81	exit if mgmt_screen($cf, $cgi, $ses, $op);
82    }
83} elsif ($op eq 'B') {
84    $md = Net::SAML::sp_meta($cf, $cgi);
85    printf "CONTENT-LENGTH: %d\r\nCONTENT-TYPE: text/xml\r\n\r\n%s", length $md, $md;
86    exit;
87} elsif ($op eq 'K') {
88    warn "Redirect back from SLO";
89} else {
90    warn "Unknown op($op)";
91}
92
93print <<HTML;
94CONTENT-TYPE: text/html
95
96<title>ZXID SP PERL SSO</title>
97<link rel="shortcut icon" href="/favicon.ico" type="image/x-icon" />
98<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>
99</pre><form method=post action="zxid.pl?o=P">
100
101<h3>Login Using New IdP</h3>
102
103<i>A new IdP is one whose metadata we do not have yet. We need to know
104the Entity ID in order to fetch the metadata using the well known
105location method. You will need to ask the adminstrator of the IdP to
106tell you what the EntityID is.</i>
107
108<p>IdP EntityID URL <input name=e size=100>
109<input type=submit name=l1 value=" Login (SAML20:Artifact) ">
110<input type=submit name=l2 value=" Login (SAML20:POST) ">
111
112HTML
113    ;
114
115$idp = Net::SAML::load_cot_cache($cf);
116if ($idp) {
117    print "<h3>Login Using Known IdP</h3>\n";
118    while ($idp) {
119	$eid = Net::SAML::zxid_entity::swig_eid_get($idp);
120	$eid_len = Net::SAML::zxid_entity::swig_eid_len_get($idp);
121	$eid = substr($eid, 0, $eid_len);
122	warn "eid_len($eid_len) eid($eid)";
123	print <<HTML;
124<input type=submit name="l1$eid" value=" Login to $eid (SAML20:Artifact) ">
125<input type=submit name="l2$eid" value=" Login to $eid (SAML20:POST) ">
126HTML
127;
128	$idp = Net::SAML::zxid_entity::swig_n_get($idp);
129    }
130}
131
132$version_str = Net::SAML::version_str();
133
134print <<HTML;
135<h3>CoT configuration parameters your IdP may need to know</h3>
136
137Entity ID of this SP: <a href="$url?o=B">$url?o=B</a> (Click on the link to fetch SP metadata.)
138
139<h3>Technical options (typically hidden fields on production site)</h3>
140
141<input type=checkbox name=fc value=1 checked> Allow new federation to be created<br>
142<input type=checkbox name=fp value=1> Do not allow IdP to interact (e.g. ask password) (IsPassive flag)<br>
143<input type=checkbox name=ff value=1> IdP should reauthenticate user (ForceAuthn flag)<br>
144NID Format: <select name=fn><option value=prstnt>Persistent<option value=trnsnt>Transient<option value="">(none)</select><br>
145Affiliation: <select name=fq><option value="">(none)</select><br>
146
147Consent: <select name=fy><option value="">(empty)
148<option value="urn:liberty:consent:obtained">obtained
149<option value="urn:liberty:consent:obtained:prior">obtained:prior
150<option value="urn:liberty:consent:obtained:current:implicit">obtained:current:implicit
151<option value="urn:liberty:consent:obtained:current:explicit">obtained:current:explicit
152<option value="urn:liberty:consent:unavailable">unavailable
153<option value="urn:liberty:consent:inapplicable">inapplicable
154</select><br>
155Authn Req Context: <select name=fa><option value="">(none)
156<option value=pw>Password
157<option value=pwp>Password with Protected Transport
158<option value=clicert>TLS Client Certificate</select><br>
159Matching Rule: <select name=fm><option value=exact>Exact
160<option value=minimum>Min
161<option value=maximum>Max
162<option value=better>Better
163<option value="">(none)</select><br>
164
165</form><hr><a href="http://zxid.org/">zxid.org</a>, $version_str
166HTML
167    ;
168
169### Logged in case
170
171sub mgmt_screen {
172    my ($cf, $cgi, $ses, $op) = @_;
173    warn "mgmt op($op)";
174    if ($op eq 'l') {
175	Net::SAML::del_ses($cf, $ses);
176	$msg = "Local logout Ok. Session terminated.";
177	return 0;  # Simply abandon local session. Falls thru to login screen.
178    } elsif ($op eq 'r') {
179	Net::SAML::sp_slo_redir($cf, $cgi, $ses);
180	Net::SAML::del_ses($cf, $ses);
181	return 1;  # Redirect already happened. Do not show login screen.
182    } elsif ($op eq 's') {
183	Net::SAML::sp_slo_soap($cf, $cgi, $ses);
184	Net::SAML::del_ses($cf, $ses);
185	$msg = "SP Initiated logout (SOAP). Session terminated.";
186	return 0;  # Falls thru to login screen.
187    } elsif ($op eq 't') {
188	Net::SAML::sp_nireg_redir($cf, $cgi, $ses, '');
189	return 1;  # Redirect already happened. Do not show login screen.
190    } elsif ($op eq 'u') {
191	Net::SAML::sp_nireg_soap($cf, $cgi, $ses, '');
192	$msg = "SP Initiated defederation (SOAP).";
193    } elsif ($op eq 'P') {
194	$ret = Net::SAML::sp_dispatch($cf, $cgi, $ses, Net::SAML::zxid_cgi::swig_saml_resp_get($cgi));
195	return 0 if $ret == 1;
196	return 1 if $ret == 2;
197    } elsif ($op eq 'Q') {
198	$ret = Net::SAML::sp_dispatch($cf, $cgi, $ses, Net::SAML::zxid_cgi::swig_saml_req_get($cgi));
199	return 0 if $ret == 1;
200	return 1 if $ret == 2;
201    }
202
203    $sid = Net::SAML::zxid_ses::swig_sid_get($ses);
204    $nid = Net::SAML::zxid_ses::swig_nid_get($ses);
205
206    # In gimp flatten the image and Save Copy as pnm
207    # giftopnm favicon.gif | ppmtowinicon >favicon.ico
208    #printf("COOKIE: foo\r\n");
209    print <<HTML;
210CONTENT-TYPE: text/html
211
212<title>ZXID SP Mgmt</title>
213<link rel="shortcut icon" href="/favicon.ico" type="image/x-icon" />
214<body bgcolor="#330033" text="#ffaaff" link="#ffddff" vlink="#aa44aa" alink="#ffffff"><font face=sans>
215
216<h1>ZXID SP Perl Management (user logged in, session active)</h1><pre>
217</pre><form method=post action="zxid.pl?o=P">
218<input type=hidden name=s value="$sid">
219<input type=submit name=gl value=" Local Logout ">
220<input type=submit name=gr value=" Single Logout (Redir) ">
221<input type=submit name=gs value=" Single Logout (SOAP) ">
222<input type=submit name=gt value=" Defederate (Redir) ">
223<input type=submit name=gu value=" Defederate (SOAP) ">
224
225<h3>Technical options (typically hidden fields on production site)</h3>
226
227sid($sid) nid($nid) <a href="zxid.pl?s=$sid">Reload</a>
228
229</form><hr>
230<a href="http://zxid.org/">zxid.org</a>
231HTML
232;
233  return 1;
234}
235
236__EOF__
237