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