1#!/usr/local/bin/perl 2# Copyright (c) 2007-2009 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: zxidhlo.pl,v 1.7 2009-11-14 22:44:43 sampo Exp $ 9# 16.1.2007, created --Sampo 10# 14.11.2009, Added zxid_az() example --Sampo 11 12use Net::SAML; 13use Data::Dumper; 14 15$| = 1; 16undef $/; 17 18open STDERR, ">>tmp/zxid.stderr"; # Helps CGI debugging where web server eats the stderr 19 20#$url = "https://sp1.zxidsp.org:8443/zxidhlo.pl"; # Edit to match your situation 21$url = "http://sp.tas3.pt:8082/zxidhlo.pl"; # Edit to match your situation 22$conf = "PATH=/var/zxid/&URL=$url"; 23$cf = Net::SAML::new_conf_to_cf($conf); 24#warn "cf($cf):".Dumper($cf); 25$qs = $ENV{'QUERY_STRING'}; 26$qs = <STDIN> if $qs =~ /o=P/; 27$res = Net::SAML::simple_cf($cf, -1, $qs, undef, 0x1828); 28$op = substr($res, 0, 1); 29if ($op eq 'L' || $op eq 'C') { warn "res($res) len=".length($res); print $res; exit; } # LOCATION (Redir) or CONTENT 30if ($op eq 'n') { exit; } # already handled 31if ($op eq 'e') { my_render_login_screen(); exit; } 32if ($op ne 'd') { die "Unknown Net::SAML::simple() res($res)"; } 33 34# *** add code to parse the LDIF in $res into a hash of attributes 35 36($sid) = $res =~ /^sesid: (.*)$/m; 37 38if (Net::SAML::az_cf($cf, "Action=Show", $sid)) { 39 $az = "Permit.\n"; 40} else { 41 $az = "<b>Deny.</b> Normally page would not be shown, but we show session attributes for debugging purposes.\n"; 42} 43 44print <<HTML 45CONTENT-TYPE: text/html 46 47<title>ZXID perl HLO SP Mgmt</title> 48<link rel="shortcut icon" href="/favicon.ico" type="image/x-icon" /> 49<body bgcolor="#330033" text="#ffaaff" link="#ffddff" vlink="#aa44aa" alink="#ffffff"><font face=sans> 50$az 51<h1>ZXID SP Perl HLO Management (user logged in, session active)</h1> 52sesid: $sid 53HTML 54 ; 55print Net::SAML::fed_mgmt_cf($cf, undef, -1, $sid, 0x1900); 56exit; 57 58### 59### Render the login screen 60### 61 62sub my_render_login_screen { 63 print <<HTML; 64CONTENT-TYPE: text/html 65 66<title>ZXID SP PERL HLO SSO</title> 67<link rel="shortcut icon" href="/favicon.ico" type="image/x-icon" /> 68<body bgcolor="#330033" text="#ffaaff" link="#ffddff" vlink="#aa44aa" alink="#ffffff"><font 69face=sans><h1>ZXID SP Perl HLO Federated SSO (user NOT logged in, no session.)</h1> 70<form method=get action="zxidhlo.pl"> 71 72<h3>Login Using New IdP</h3> 73 74<i>A new IdP is one whose metadata we do not have yet. We need to know 75the Entity ID in order to fetch the metadata using the well known 76location method. You will need to ask the adminstrator of the IdP to 77tell you what the EntityID is.</i> 78 79<p>IdP URL <input name=e size=60> 80<input type=submit name=l1 value=" Login (A2) "> 81<input type=submit name=l2 value=" Login (P2) "> 82HTML 83; 84 print Net::SAML::idp_list_cf($cf, undef, 0x1c00); # Get the IdP selection form 85 print <<HTML; 86<h3>CoT configuration parameters your IdP may need to know</h3> 87 88Entity ID of this SP: <a href="$url?o=B">$url?o=B</a> (Click on the link to fetch SP metadata.) 89 90<h3>Technical options</h3> 91<input type=checkbox name=fc value=1 checked> Create federation, 92 NID Format: <select name=fn> 93 <option value=prstnt>Persistent 94 <option value=trnsnt>Transient 95 <option value="">(none) 96 </select><br> 97 98<input type=hidden name=fq value=""> 99<input type=hidden name=fy value=""> 100<input type=hidden name=fa value=""> 101<input type=hidden name=fm value=""> 102<input type=hidden name=fp value=0> 103<input type=hidden name=ff value=0> 104 105</form><hr><a href="http://zxid.org/">zxid.org</a> 106HTML 107 ; 108} 109 110__END__ 111