1#!/usr/bin/perl
2# Copyright (c) 2010 Sampo Kellomaki (sampo@iki.fi), All Rights Reserved.
3# This is confidential unpublished proprietary source code of the author.
4# NO WARRANTY, not even implied warranties. Contains trade secrets.
5# Distribution prohibited unless authorized in writing.
6# Licensed under Apache License 2.0, see file COPYING.
7# $Id$
8#
9# 17.2.2010, created --Sampo
10#
11# Web GUI CGI for exploring ZXID logs and audit trail
12#
13# CGI / QUERY_STRING variables
14#   c  $cmd    Command
15#   d  $dir    Path to ZXID config directory, e.g: /var/zxid/ or /var/zxid/idp
16#   e  $eid    Filter logs by Entity ID
17#   n  $nid    Filter logs by Name ID
18#   s  $sid    Filter logs by session ID
19
20$usage = <<USAGE;
21Web GUI for attribute selection and privacy preferences
22Usage: http://localhost:8081/zxidatsel.pl?QUERY_STRING
23       ./zxidcot.pl -a QUERY_STRING
24         -a Ascii mode
25USAGE
26    ;
27die $USAGE if $ARGV[0] =~ /^-[Hh?]/;
28$ascii = shift if $ARGV[0] eq '-a';
29
30$path = '/var/zxid/idp';
31
32$bot = <<HTML;
33<div class=zxbot>
34<a class=zx href="http://zxid.org/">ZXID.org</a>
35| <a class=zx href="http://www.tas3.eu/">TAS3.eu</a>
36-- <a class=zx href="/index-idp.html">Top</a>
37| <a class=zx href="?op=md">Register Metadata</a>
38| <a class=zx href="?op=viewcot">View Metadata</a>
39| <a class=zx href="?op=direg">Register Web Service</a>
40| <a class=zx href="?op=viewreg">View Discovery</a>
41</div>
42HTML
43    ;
44
45use Data::Dumper;
46
47close STDERR;
48open STDERR, ">>/var/tmp/zxid.stderr" or die "Cant open error log: $!";
49select STDERR; $|=1; select STDOUT;
50
51$ENV{QUERY_STRING} ||= shift;
52cgidec($ENV{QUERY_STRING});
53
54if ($ENV{CONTENT_LENGTH}) {
55    sysread STDIN, $data, $ENV{CONTENT_LENGTH};
56    #warn "GOT($data) $ENV{CONTENT_LENGTH}";
57    cgidec($data);
58}
59warn "$$: cgi: " . Dumper(\%cgi);
60
61sub uridec {
62    my ($val) = @_;
63    $val =~ s/\+/ /g;
64    $val =~ s/%([0-9a-f]{2})/chr(hex($1))/gsexi;  # URI decode
65    return $val;
66}
67
68sub urienc {
69    my ($val) = @_;
70    $val =~ s/([^A-Za-z0-9.,_-])/sprintf("%%%02x",ord($1))/gsex; # URI enc
71    return $val;
72}
73
74sub cgidec {
75    my ($d) = @_;
76    for $nv (split '&', $d) {
77	($n, $v) = split '=', $nv, 2;
78	$cgi{$n} = uridec($v);
79    }
80}
81
82sub readall {
83    my ($f) = @_;
84    my ($pkg, $srcfile, $line) = caller;
85    undef $/;         # Read all in, without breaking on lines
86    open F, "<$f" or die "$srcfile:$line: Cant read($f): $!";
87    binmode F;
88    my $x = <F>;
89    close F;
90    return $x;
91}
92
93sub show_templ {
94    my ($templ, $hr) = @_;
95    $templ = readall($templ);
96    $templ =~ s/!!(\w+)/$$hr{$1}/gs;
97    my $len = length $templ;
98    syswrite STDOUT, "Content-Type: text/html\r\nContent-Length: $len\r\n\r\n$templ";
99    exit;
100}
101
102sub redirect {
103    my ($url) = @_;
104    syswrite STDOUT, "Location: $url\r\n\r\n";
105    exit;
106}
107
108### Metadata
109
110if ($cgi{'op'} eq 'md') {
111    syswrite STDOUT, "Content-Type: text/html\r\n\r\n".<<HTML;
112<title>ZXID IdP CoT Mgr: MD Reg</title>
113<link type="text/css" rel=stylesheet href="an.css">
114<h1 class=zxtop>ZXID IdP Circle of Trust Manager</h1>
115
116<h3>Service Provider Metadata Registration</h3>
117
118<form method=post xaction="zxidcot.pl">
119Paste metadata here:<br>
120<textarea name=mdxml cols=80 rows=10>
121</textarea><br>
122<input type=submit name="okmd" value="Submit Metadata">
123</form>
124$bot
125HTML
126    ;
127    exit;
128}
129
130if ($cgi{'okmd'}) {
131    (undef, $eid) = $cgi{'mdxml'} =~ /entityID=([\"\']?)([^\"\' >]+)$1/;
132    open COT, "|./zxcot -a ${path}cot/" or die "Cant write pipe zxcot -a ${path}cot/: $! $?";
133    print COT $cgi{'mdxml'};
134    close COT;
135    open COT, "./zxcot -p '$eid'|" or die "Cant read pipe zxcot -p $eid: $! $?";
136    $cgi{'sha1name'} = <COT>;
137    close COT;
138    chomp $cgi{'sha1name'};
139    $cgi{'msg'} = "<span class=zxmsg>Metadata for $eid added.</span>";
140    $cgi{'op'}  = 'viewcot';  # Fall thru to viewcot
141}
142
143if ($cgi{'op'} eq 'viewcot') {
144    open COT, "./zxcot ${path}cot/|" or die "Cant read pipe zxcot ${path}cot/: $! $?";
145    while ($line = <COT>) {
146	($mdpath, $eid, $desc) = split /\s+/, $line, 3;
147	($sha1name) = $mdpath =~ /\/([A-Za-z0-9_-]+)$/;
148	$ts = gmtime((stat($mdpath))[9]);
149	if ($sha1name eq $cgi{'sha1name'}) {
150	    push @splist, "<tr><td><a href=\"$eid\">$eid</a></td><td><b><a href=\"?op=view1md&sha1name=$sha1name\">$sha1name</a></b></td><td>$ts</td><td>$desc</td></tr>\n";
151	} else {
152	    push @splist, "<tr><td><a href=\"$eid\">$eid</a></td><td><a href=\"?op=view1md&sha1name=$sha1name\">$sha1name</a></td><td>$ts</td><td>$desc</td></tr>\n";
153	}
154    }
155    close COT;
156    $splist = join '', sort @splist;
157    syswrite STDOUT, "Content-Type: text/html\r\n\r\n".<<HTML;
158<title>ZXID IdP CoT Mgr: SP List</title>
159<link type="text/css" rel=stylesheet href="an.css">
160<h1 class=zxtop>ZXID IdP Circle of Trust Manager</h1>
161$cgi{'msg'}
162<h3>Service Provider Metadata Listing</h3>
163<i>This listing reflects the Service Providers known to us, i.e. in our Circle of Trust.</i>
164
165<table>
166<tr><th>EntityID</th><th>Metadata (sha1name)</th><th>Last updated</th><th>Description</th></tr>
167$splist
168</table>
169
170$bot
171HTML
172    ;
173    exit;
174}
175
176if ($cgi{'op'} eq 'view1md') {   # View one metadata
177    $fn = $cgi{'sha1name'};
178    die "Malicious sha1name($fn)" unless $fn =~ /^[A-Za-z0-9_-]+$/;
179    $md = readall("${path}cot/$fn");
180    syswrite STDOUT, "Content-Type: text/xml\r\n\r\n".$md;
181    exit;
182}
183
184### Discovery Registration
185
186if ($cgi{'op'} eq 'direg') {
187    syswrite STDOUT, "Content-Type: text/html\r\n\r\n".<<HTML;
188<title>ZXID IdP CoT Mgr: DI Reg</title>
189<link type="text/css" rel=stylesheet href="an.css">
190<h1 class=zxtop>ZXID IdP Circle of Trust Manager</h1>
191
192<h3>Web Service Discovery Registration</h3>
193
194<form method=post xaction="zxidcot.pl">
195
196<table>
197<tr><th>Endpoint URL</th><td><input name=endpoint size=60></td></tr>
198<tr><th>Abstract</th><td><input name=abstract size=60></td></tr>
199<tr><th>Entity ID</th><td><input name=eid size=60></td></tr>
200<tr><th>Service Type (URN)</th><td><input name=svctype size=60></td></tr>
201</table>
202<p><input type=submit name="okdireg" value="Submit Discovery Registration">
203</form>
204$bot
205HTML
206    ;
207    exit;
208}
209
210if ($cgi{'okdireg'}) {
211    warn "./zxcot -e '$cgi{'endpoint'}' '$cgi{'abstract'}' '$cgi{'eid'}' '$cgi{'svctype'}' | ./zxcot -b ${path}dimd/";
212    system "./zxcot -e '$cgi{'endpoint'}' '$cgi{'abstract'}' '$cgi{'eid'}' '$cgi{'svctype'}' | ./zxcot -b ${path}dimd/";
213    $cgi{'msg'} = "<span class=zxmsg>Registration for $cgi{'eid'} added.</span>";
214    $cgi{'op'} = 'viewreg';  # Fall through to viewreg
215}
216
217if ($cgi{'op'} eq 'viewreg') {
218    #open COT, "./zxcot ${path}dimd/|" or die "Cant read pipe zxcot ${path}dimd/: $! $?";
219    opendir DIMD, "${path}dimd/" or die "Cant read dir ${path}dimd/ $!";
220    while ($fn = readdir DIMD) {
221	next if $fn =~ /^\./;
222	$data = readall("${path}dimd/$fn");
223	(undef, undef, $svctype) = $data =~ /<((\w+:)?ServiceType)[^>]*>([^<]*)<\/\1>/;
224	(undef, undef, $eid)  = $data =~ /<((\w+:)?ProviderID)[^>]*>([^<]*)<\/\1>/;
225	(undef, undef, $desc) = $data =~ /<((\w+:)?Abstract)[^>]*>([^<]*)<\/\1>/;
226	(undef, undef, $url)  = $data =~ /<((\w+:)?Address)[^>]*>([^<]*)<\/\1>/;
227	#$dbg .= "\n===== $fn =====\n" . $data . "\n---- svctype($svctype) eid($eid) desc($desc) url($url)";
228	push @{$by_type{$svctype}}, $fn;
229	$ts = gmtime((stat("${path}dimd/$fn"))[9]);
230	$line{$fn} = "<tr><td>EntityID:<br>Endpoint:<br>File:</td><td><a href=\"$eid\">$eid</a><br><a href=\"$url\">$url</a><br><a href=\"?op=view1reg&sha1name=$fn\">$fn</a></td><td>$ts</td><td>$desc</td></tr>\n";
231    }
232    close COT;
233
234    for $svctype (sort keys %by_type) {
235	$reglist .= "<tr><th colspan=4>$svctype</th></tr>\n"
236	    . join('', sort map($line{$_}, @{$by_type{$svctype}}));
237    }
238
239    syswrite STDOUT, "Content-Type: text/html\r\n\r\n".<<HTML;
240<title>ZXID IdP CoT Mgr: SP List</title>
241<link type="text/css" rel=stylesheet href="an.css">
242<h1 class=zxtop>ZXID IdP Circle of Trust Manager</h1>
243$cgi{'msg'}
244<h3>Web Service Discovery Registration Listing</h3>
245<i>This listing reflects the web services known to us, i.e. the ones that are discoverable.</i>
246
247<table>
248<tr><th colspan=2>Service Type / EntityID / Endpoint URL / sha1name</th><th>Last updated</th><th>Description</th></tr>
249$reglist
250</table>
251$bot
252HTML
253    ;
254#<textarea cols=100 rows=40>$dbg</textarea>
255    exit;
256}
257
258if ($cgi{'op'} eq 'view1reg') {   # View one metadata
259    $fn = $cgi{'sha1name'};
260    die "Malicious sha1name($fn)" if $fn =~ /\.\./;
261    $reg = readall("${path}dimd/$fn");
262    syswrite STDOUT, "Content-Type: text/xml\r\n\r\n".$reg;
263    exit;
264}
265
266warn "Unsupported op($cgi{'op'})";
267redirect('/?err=unsupported-op');
268
269__END__
270