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