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