#!/v/openpkg/sw/bin/perl
##
## registry-ui.pl - OpenPKG Registry - User Interface (mod_perl)
## Copyright (c) 2000-2005 OpenPKG Foundation e.V. <http://openpkg.net/>
## Copyright (c) 2000-2005 Ralf S. Engelschall <http://engelschall.com/>
##
## Permission to use, copy, modify, and distribute this software for
## any purpose with or without fee is hereby granted, provided that
## the above copyright notice and this permission notice appear in all
## copies.
##
## THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESSED OR IMPLIED
## WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
## MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
## IN NO EVENT SHALL THE AUTHORS AND COPYRIGHT HOLDERS AND THEIR
## CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
## SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
## LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF
## USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
## ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
## OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT
## OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
## SUCH DAMAGE.
##
require 5.008;
use strict;
use Data::Dumper;
use OSSP::cfg;
use DBI;
use DBD::Pg;
use CGI;
use CGI::Cookie;
use CGI::Session;
use CGI::GuruMeditation;
use MIME::Base64;
use XML::Simple;
use String::Divert;
use OSSP::uuid;
# program name, version and date
my $progname="registry-ui.pl";
my $progvers="1.1.3";
my $progdate="24-Aug-2007";
# configure data dumper
$Data::Dumper::Purity = 1;
$Data::Dumper::Indent = 1;
$Data::Dumper::Terse = 1;
# determine path to OpenPKG instance
my $PREFIX='/v/openpkg/sw';
$PREFIX=$ENV{OPENPKG_PREFIX} if ($ENV{OPENPKG_PREFIX} ne "");
# registry common code
my $pm = "registry.pm";
$pm = "$PREFIX/libexec/openpkg-registry/registry.pm" unless($PREFIX =~ m/^@.*@$/);
require $pm; import registry;
# handle configuration
my $defcfgtxt = ®istry::getdefcfgtxt($PREFIX);
my $defcfg = ®istry::parsecfgtxt($defcfgtxt);
my $usecfgtxt = ®istry::readcfgtxtfile(®istry::getcfgfilename($PREFIX));
my $usecfg = ®istry::parsecfgtxt($usecfgtxt);
my $cfg = ®istry::mergecfg($defcfg, $usecfg);
# configure optional debugging
CGI::GuruMeditation::configure(-debug => $cfg->{debug}->{ui});
# initialize output
my $response = {};
$response->{header} = {};
$response->{message} = new String::Divert;
$response->{message}->fold("message");
# optional OSSP::ase integration
my $ase;
$ase = undef;
if ($cfg->{identification}->{mode} eq "ase") {
#use OSSP::ase::client; # FIXME production
require "./ase.pm"; import OSSP::ase::client; # FIXME development
}
# create objects
my $cgi = new CGI;
my $myurl = $cgi->url(-relative => 1) || ".";
my $sid = $cgi->cookie("registry-sid") || undef;
my $requestedpage = $cgi->url_param("page") || $cfg->{page}->{default}; $cgi->delete(-name=>'page');
my $session; $session = undef;
# database handle and scratch variables
#
my $sql; # scratch SQL string database operations
my $rv; # scratch return value for database operations
my $rc; # scratch return code for database operations
my $sth; # scratch statement handle for database operations
my $msg; # scratch variable for message fiddling
my $dbh; # database handle
my $dbs; # database handle for session
sub dbopen ($) {
my ($db) = @_;
my $dbi;
$dbi = undef;
if ($db eq "registry") {
my $tablespace = $cfg->{db}->{registry}->{tablespace};
my $host = $cfg->{db}->{registry}->{host};
my $username = $cfg->{db}->{registry}->{username};
my $password = $cfg->{db}->{registry}->{password};
$dbi = DBI->connect (
"DBI:Pg:dbname=$tablespace;host=$host", $username, $password,
{
PrintError => 0,
PrintWarn => 0,
RaiseError => 0,
AutoCommit => 0
}
);
}
elsif ($db eq "session") {
my $dbfile = $cfg->{db}->{session}->{dbfile};
$dbi = DBI->connect (
"DBI:SQLite:dbname=$dbfile", "", "",
{
PrintError => 0,
PrintWarn => 0,
RaiseError => 0,
AutoCommit => 1
}
);
}
else {
die "dbopen does not know how to handle db=\"".$db."\"";
}
return $dbi;
}
# first check for pages which do not require database access
#
if ($requestedpage eq "css") {
&viewcss();
goto CUS;
}
elsif ($requestedpage eq "jpg") {
&viewjpg($cgi->param("name"));
goto CUS;
}
elsif ($requestedpage eq "gif") {
&viewgif($cgi->param("name"));
goto CUS;
}
else {
# pages below require database access
#
$dbh = &dbopen("registry");
if (not defined $dbh) {
&viewprettyerror("Registry database backend unavailable", &prettydbi());
goto CUS;
}
$dbs = &dbopen("session");
if (not defined $dbs) {
&viewprettyerror("Session database not accessible", &prettydbi());
goto CUS;
}
# establish CGI Session object
CGI::Session->name("registry-sid");
$session = new CGI::Session(
"driver:sqlite;serializer:Storable;id:uuid", $sid, { Handle => $dbs, TableName => 'session' }
);
if (not defined $session) {
&viewprettyerror("Session handling failed", "");
goto CUS;
}
# response cookies for session persistency
$session->expire("+3600s");
if ($session->is_new()) {
$response->{header}->{cookie} = $cgi->cookie(
-name => $session->name(),
-value => $session->id(),
-expires => sprintf("+%ds", $session->expires()),
-path => $cgi->url(-absolute => 1)
)
}
if ($cfg->{identification}->{mode} eq "ase") {
# establish ASE object
#
$ase = new OSSP::ase::client(
-server => $cfg->{identification}->{ase}->{server},
-cgi => $cgi,
-mode => "page",
-session => $session,
);
if (not defined $ase) {
&viewprettyerror("Affiliation Services Environment", "");
goto CUS;
}
# give it a chance to run
#
if ($ase->responsible()) {
if($ase->action()) {
print $ase->response();
}
else {
&viewprettyerror("Affiliation Services Environment", $ase->error());
}
goto CUS;
}
}
# continue to the pages that require database access
#
if ($requestedpage eq "login") {
&viewlogin();
}
elsif ($requestedpage eq "logout") {
&viewlogout();
}
elsif ($requestedpage eq "asecomeback") {
&viewasecomeback();
}
elsif ($requestedpage eq "profile") {
&viewprofile();
}
elsif ($requestedpage eq "association") {
&viewassociation();
}
elsif ($requestedpage eq "dropxml") {
&viewdropxml();
}
elsif ($requestedpage eq "ase") {
&viewemptypage();
}
elsif ($requestedpage eq "main") {
&viewmainpage();
}
else {
$cgi->delete_all();
&viewemptypage();
}
}
# cleanup sequence
#
CUS:
if ($response->{header}->{redirect}) {
print STDOUT $cgi->redirect(
-nph => 0,
-uri => $response->{header}->{redirect},
-type => $response->{header}->{type},
-status => $response->{header}->{status},
-expires => $response->{header}->{expires},
-cookie => $response->{header}->{cookie}
) . $response->{message}->unfold();
}
else {
print STDOUT $cgi->header(
-nph => 0,
-type => $response->{header}->{type},
-status => $response->{header}->{status},
-expires => $response->{header}->{expires},
-cookie => $response->{header}->{cookie}
) . $response->{message}->unfold();
}
$response->{message}->destroy();
undef $response->{message};
undef $ase;
undef $session;
undef $cgi;
undef $dbh;
exit(0);
# check whether user agent is openpkg-register
#
sub uao ()
{
return $cgi->user_agent() =~ m:^openpkg-regist(er|ry)/\d+[\.ab]\d+[\.ab]\d+$:;
}
sub viewhtmlhead (;$)
{
my ($menu) = @_;
my $head;
$head = "";
$head .= "<html>\n";
$head .= " <head>\n";
$head .= " <link rel=\"stylesheet\" type=\"text/css\" href=\"$myurl?page=css\"/>\n";
if ($cfg->{identification}->{mode} eq "ase" and defined $ase) {
$head .= $ase->canvas(-part => "head") . "\n";
}
$head .= &printjscheckallboxes();
$head .= " </head>\n";
$head .= " <body class=\"registry\"><div class=\"registry\">\n";
$head .= " <div id=\"logo\"></div>\n";
$head .= " <h1>OpenPKG Registry</h1>\n";
if ($menu =~ m/-menu/) {
my $td;
$head .= " <table class=\"menu\">\n";
$head .= " <tr>\n";
$td = 0;
$head .= " " . &viewmainform() . "\n"; $td++;
$head .= " " . &viewdropxmlform() . "\n"; $td++;
$head .= " " . &viewloginform() . "\n"; $td++;
$head .= " " . &viewprofileform() . "\n"; $td++;
$head .= " " . &viewassociationform() . "\n"; $td++;
$head .= " " . &viewlogoutform() . "\n"; $td++;
$head .= " </tr>\n";
$head .= " <tr>\n";
$head .= " <td colspan=\"" . $td . "\">\n";
$head .= " </td>\n";
$head .= " </tr>\n";
$head .= " </table>\n";
}
return $head;
}
sub prettyauthinfo ($)
{
my ($mode) = @_;
my ($boldon, $boldoff, $text, $username);
($boldon, $boldoff) = '';
($boldon, $boldoff) = ('<b>', '</b>') if ($mode eq 'fancy');
$text = "";
$username = &identifyusername();
if (defined $username) {
$text .= "authenticated as " . $boldon . $username . $boldoff;
}
else {
$text .= "you are " . $boldon . "not authenticated" . $boldoff;
}
if ($cfg->{identification}->{mode} eq "ase" and defined $ase) {
$text .= " via ase login";
}
elsif ($cfg->{identification}->{mode} eq "basicauth") {
$text .= " via basic authentication";
}
elsif ($cfg->{identification}->{mode} eq "naive") {
$text .= " via naive input";
}
elsif ($cfg->{identification}->{mode} eq "constant") {
$text .= " via constant setting";
}
else {
$text .= " through magic";
}
return $text;
}
sub viewhtmltail ()
{
my ($msg, $html);
$html = "";
if ($cfg->{identification}->{mode} eq "ase" and defined $ase) {
$html .= $ase->canvas(-part => "body") . "\n";
}
$msg = "";
if ($cfg->{status}->{showversion}) {
$msg .= ($msg ? " | " : "" );
$msg .= $progname . " " . $progvers . " (" . $progdate . ")";
}
if ($cfg->{status}->{showuser}) {
$msg .= ($msg ? " | " : "" );
$msg .= &prettyauthinfo('dumb');
}
if ($cfg->{status}->{showsid}) {
$msg .= ($msg ? " | " : "" );
$msg .= "sid=" . ( defined $session ? $session->id : "undef" );
}
if ($msg) {
$html .= "<p/>\n";
$html .= "<div class=\"status\">\n";
$html .= $msg;
$html .= "</div>\n";
}
$html .= " </div></body>\n";
$html .= "</html>\n";
return $html;
}
sub viewcss () {
my $css;
# HTTP header
$response->{header}->{type} = 'text/css';
$response->{header}->{expires} = '+3600s';
# HTTP message
$response->{message}->divert("message");
$css = '';
$css .= "/*\n";
$css .= "** registry-ui.pl - OpenPKG registration user interface\n";
$css .= "*/\n";
$css .= "\n";
$css .= "BODY.registry {\n";
$css .= " background: #cccccc;\n";
$css .= "}\n";
$css .= "DIV.registry {\n";
$css .= " font-family: sans-serif, helvetica, arial;\n";
$css .= "}\n";
$css .= "DIV.status {\n";
$css .= " font-family: sans-serif, helvetica, arial;\n";
$css .= " font-size: 100% /* 66% */;\n";
$css .= "}\n";
$css .= "BODY.registry DIV.registry {\n";
$css .= " background-image: url($myurl?page=jpg&name=bg);\n";
$css .= " border: 1px solid #000000;\n";
$css .= " padding: 20px 20px 20px 20px;\n";
$css .= " font-family: sans-serif, helvetica, arial;\n";
$css .= "}\n";
$css .= "img#logo {\n";
$css .= " display:none\n";
$css .= "}\n";
$css .= "BODY.registry img#logo {\n";
$css .= " display:block\n";
$css .= "}\n";
$css .= ".registry table {\n";
$css .= " padding: 0px 0px 0px 0px;\n";
$css .= " font-family: tahoma, sans-serif, helvetica, arial;\n";
$css .= " font-size: 100%;\n";
$css .= "}\n";
$css .= ".registry tr {\n";
$css .= " padding: 0px 0px 0px 0px;\n";
$css .= "}\n";
$css .= ".registry td {\n";
$css .= " vertical-align: top;\n";
$css .= " padding: 0px 0px 0px 0px;\n";
$css .= "}\n";
$css .= ".registry input {\n";
$css .= " width: 100%;\n";
$css .= "}\n";
$css .= ".registry H1 {\n";
$css .= " font-family: tahoma, sans-serif, helvetica, arial;\n";
$css .= " font-weight: bold;\n";
$css .= " font-size: 200%;\n";
$css .= "}\n";
$css .= ".registry H2 {\n";
$css .= " font-family: sans-serif, helvetica, arial;\n";
$css .= " font-weight: bold;\n";
$css .= " font-size: 140%;\n";
$css .= "}\n";
$css .= ".registry A {\n";
$css .= " text-decoration: none;\n";
$css .= " color: #6666aa;\n";
$css .= "}\n";
$css .= ".registry INPUT {\n";
$css .= " background: #ffffff;\n";
$css .= "}\n";
$css .= ".registry INPUT.checkbox {\n";
$css .= " width: 16px;\n";
$css .= "}\n";
$css .= ".registry TD.browse {\n";
$css .= " width: 100%;\n";
$css .= " background: #d0d0d0;\n";
$css .= "}\n";
$css .= ".registry TD.browse SPAN.title {\n";
$css .= " font-weight: bold;\n";
$css .= " font-size: 200%;\n";
$css .= " color: #000000;\n";
$css .= "}\n";
$css .= ".registry TD.query {\n";
$css .= " width: 100%;\n";
$css .= " background: #d0d0d0;\n";
$css .= "}\n";
$css .= ".registry TD.query SPAN.title {\n";
$css .= " font-weight: bold;\n";
$css .= " font-size: 200%;\n";
$css .= " color: #000000;\n";
$css .= "}\n";
$css .= ".registry TD.view {\n";
$css .= " width: 100%;\n";
$css .= " background: #d0d0d0;\n";
$css .= "}\n";
$css .= ".registry TD.view SPAN.title {\n";
$css .= " font-weight: bold;\n";
$css .= " font-size: 200%;\n";
$css .= " color: #000000;\n";
$css .= "}\n";
$css .= ".registry TD.result {\n";
$css .= " width: 100%;\n";
$css .= " background: #d0d0d0;\n";
$css .= "}\n";
$css .= ".registry TD.result SPAN.title {\n";
$css .= " font-weight: bold;\n";
$css .= " font-size: 200%;\n";
$css .= " color: #000000;\n";
$css .= "}\n";
$css .= ".registry TABLE.association {\n";
$css .= " border-collapse: separate;\n";
$css .= " border-spacing: 1px;\n";
$css .= "}\n";
$css .= ".registry TABLE.association TD {\n";
$css .= " padding: 0px 10px 0px 10px;\n";
$css .= "}\n";
$css .= ".registry TABLE.profile {\n";
$css .= " border-collapse: separate;\n";
$css .= " border-spacing: 1px;\n";
$css .= "}\n";
$css .= ".registry TABLE.profile TD {\n";
$css .= " padding: 0px 10px 0px 10px;\n";
$css .= "}\n";
$css .= ".registry TABLE.token {\n";
$css .= " border-collapse: separate;\n";
$css .= " border-spacing: 1px;\n";
$css .= "}\n";
$css .= ".registry TABLE.token TD {\n";
$css .= " padding: 0px 10px 0px 10px;\n";
$css .= "}\n";
$response->{message}->append($css);
$response->{message}->undivert(0);
}
sub viewjpg ($) {
my ($name) = @_;
$name .= ".jpg";
my $jpg = {
"bg.jpg" => <<'EOT'
/9j/4AAQSkZJRgABAQEASABIAAD//gAqQ3JlYXRlZCB3aXRoIEdJTVAgYnkgUmFsZiBTLiBFbmdl
bHNjaGFsbP/bAEMABAIDAwMCBAMDAwQEBAQFCQYFBQUFCwgIBgkNCw0NDQsMDA4QFBEODxMPDAwS
GBITFRYXFxcOERkbGRYaFBYXFv/bAEMBBAQEBQUFCgYGChYPDA8WFhYWFhYWFhYWFhYWFhYWFhYW
FhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFv/AABEIB9AFAAMBIgACEQEDEQH/xAAbAAEB
AQEBAQEBAAAAAAAAAAAAAgEDBAUGCP/EACUQAQEBAAIDAQEBAQEAAwEBAAABAgMRBCExEkFRYSIT
FDIFcf/EABcBAQEBAQAAAAAAAAAAAAAAAAABAgP/xAAaEQEBAQEBAQEAAAAAAAAAAAAAARExIUES
/9oADAMBAAIRAxEAPwD+/gAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAZdSfaDRP/wAmP9JyYv8ATRQy
alaAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAM7jQAAAAAAAA
AAAAAAAL6BO71Hk8rm6z6rv5W5MenzObdurGbVkTyc+/19bw+Rrv25anaL3PjKvq+Nzy/a9WeTN/
r4OOTcerxue/2rKY+tLK15uHnzf6753NfGtZUAoAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAACdbkc98+ZKmi9ckiNeRif14vJ8iW+q8nJyat+pq4+r/8AYzdfXXHJLHxMb1+u
+3s8fm667qauPpwceLmzZ06y9xtloAAAAAAAAAAACeW9ZVb1HDyeSfjpKPL5PJ36eTU70vktuzr0
w259MuXXqssBxuWX9T463LPyCePk3P693ic8n/6rw6z/AIm3U+UlR9zHNmumbL8fH8fmueu693j+
Rn+tSpj1icbmvimkAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABmr0575pkF6105
7585efyPJjxc/Lb/AFm1cezm8me3j5+W6vquNtv9IysZr9X+tk/1UjeoLif43Nvf069tQrtwcll9
17+HyJZ0+X7Vxaub9alTH2c7lU8Pj8/fp68b7jUqWLAVAAAAAAAC+oCeW9YfP8jk/wDVj1+Ryf8A
ix83l7vJ2xa1GX/9dqnxk+NRRshPjQT+T8rkb1AcrlGsu9ibkR59Sz43GtS/XTWUayK9vi+RMz3X
qxzzT4vWpfr0cHL+ftXUx9fN7jXk4PJnXXb1Y1+p21Ky0BQAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAABm9dQGp5Nflx5PI/P8AXl8jy+59TVx35vIkeTm5+/648nJ+/wCufXbOq3k1df1HVdJl
v5RUZipFflsgIF9HQJ6rZFflsgJ6LmrgCeK3N7ezx+efHk1O4zjv5vfYj6+N9xbw+Nz9+u3rxvuN
ypYsBUAAAAE8nrFVfUcOfl/82JR5PI5P/XXbjZ3W8vvfbZ8YaTI3poANkOoDZ8AAK2RvQOdibl1s
TYDjrKNZvb0XKdZBz493Ovr3eP5UmZO3h3hme836Sj7PHyfqOk+Pl8Hkdeu3s4ef9f1qVMegZL3G
tIAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA48vL+f683N5Xrrt5+Xn/V+uOr3WNaxfLzfr+uN
naphWcoqMYdJlUyqQEzLev8AigEijqiJ6b0rqsBnTFJFAb0Ixmp3FdRgJ47+K9fi8/bybhx6/FIP
r412t4vE5v117ezN7biVoCoAX4CeT/8AFfO8nk/99PZz8nWbHzue98jNqxs93tUicfFZ+Mq0ABsZ
02egLCRoAAADZAZ1/wAZYss/4DjrLnrD0WJsB5vz1XXi5fzW6y5ax1QfQ8fyf167evN7j4vHr8ae
vh8rv121Klj6A48XL+nZpAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAHwvz3WzKpFSObaZFSNkbI
BI3qtkBGdNkG9AwABmml+AlNUdCpUdAgy/GstBOkaVakV08ff4r6Hi8n66fKt6d/G5fz0sqV9Ycf
H5P07NsjNf8A5rUcuv8AzQeLyt9a6ebV7qvL1/7c5XOtLzVyuefq4CmyMbkGgAAQBsjYAAA3LWZa
DLE2LZYDnYnWXWxlgPPrCZPz7d7E6z2Bxc9zXs8bm/f9fPuelcXJ+Kspj7HY8PD5Fv16uPcv9a1M
dAFQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAB8eRUjZGubbJGioIzpvUAAAC/Etv1NoNZaS1oM6p1Wg
JsK3XxOgYALidRK9IoMs7JrpgD2+FyPdx67fGxyXNfR8Hk7nurKleu/Hk8nfXcerVn5r5nm760tS
OPPe9IlNXtjLS8326ZrlPi80HSVqJVSiLhGT40G2EJWgAAAANlOmX6ChkrQGWNbZ6BFibHRnQOWs
o1l3sTcg4TVy7cPPU6yi/wDkH0fH5P1/XeWV8nj5bl7fF5f19rUqWPSMmpf61pAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAHywkbI5tEjQAAAZad/4dUGDejoGAAAAzSdfVX4nQIv0ZazsVuk6bakAZ3/AKdh
hfrt4/LcuB+ugfT4ubvF7rw+brvac8tkTu/q9moZalsoqsqlQ2UHSVcrlKvNB0lUjK58EGz4yKAG
xvUBJ0oABvQJ69tKKNnxrI1BnXssaKJZYsBy1lGsu9iNRB59Z6M8lz8XuOeoD08HNb9r18XJLPr5
X6srrxcupYso+rL2OHj8sufddpqX+tay0BQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAB80BzaBnZ2DWWl7JOg
JGgAX4AJnQABay1NoKt9OeqXSKKWp7b1ey9IMO4ys7ijbU2lqbQbaztN0nv/AARute18d9ON7tXi
UHXtsrn7bKK6StRKqVBUq81zlbKo7ZrplxzXTNEdMtTKqAqfAgAClGSNBBlnbZBlBontXZgALAb0
xUqianUVfrNJRz1HPUdtIsQcdZTe47WI1AZjl1K9XBzf7Xj1GZ1qaJR9fj3LHSPncHL19r2cXLmz
pqVLHUJe4NIAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA+Z3C1g5tDZCRoAAAADNNTQGWstTqgaqLfbakUGWnYNT
qmqjVAtTay6RrQLuka2jWkW0xFavbcIk7dMQGz67cc9OUnVdeP4DbE2V0n1vQrnG9lynqygtsqJf
apQdM10zXHNXmg7SqzXKVUojtmqcs1coLljLWdt7gNlalsqhe+zstYBQbPgNnwBAAXQTS1mvhRjN
NLO0EaTfi7E34CNRGovTL8FRLZXXx+Wzf1yreLN/foR9bh3LiOjy+Nm/mPTn43ErQFQAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAB8tsjRzaAAAAC3pnbLQLU6oygy/E1SaKWptKm/UCstZquetqL1pz1tO+Ry1rsRe9ud
0m0kUaSNkVIBmOmficxciDL9deO+nLX1eKDpF5cpXTNFV1E6z6UCONz1Tvqul9uesiqzXTNcM3qu
mNA7ZVlzzpcoLzVyucVKIvtqJVSg1SWyg0ABU+Jblfg0ACptbr4yoDL8ZQAbG2KIsTr6tGkHPSdL
1/XP7roDOe9PV43DfvSfH4u7K9/DmTPxZC1vHmTKgbZAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAfNGW+2ObShL
e6Dam0tTaDbWMtZaK21lqbploKtTpnbLeoBanWuojfJ05b5BG8nI4637ZvXdTPdUb32ddtzlcyDn
MqkX0SIMkVIKgGYuRmYoHLf1WfjN/W5+A2fXTNc59XkVcre/SFSoDL8aAi5ZJ06M1O1DOl505XPT
c6B6M1UccadM0FyqlQSiOsrUStlBcrUgKJ9Z21RXcZ3GCDbWX4y0l7BjemgAAMv1z06ac9g53/F8
XF3qVmc96e3x+P18WCuDHWXafGZnUa3GQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAHywZa5tNt6Z2ztnYrWX6
y1OtCN1U2ptYKrtnbLXPe+gXrXTjycqN8jlrXYit77qLezv2Azr2qQkVn6o3MVGT61BtrGydt/IJ
Vn22Zb10DZ6alWVHLk+r4/jOSe24QFRKp8Fimz6yUiCopMqgAD08ZqdouenQsBEvS86Rcs+KO80q
V55p0xoR2lVK5SrlBcv+NlRKqUFEZK2AoAEk+gChkrQBufhpROq47v8A6Vya9mM/qyoO/jcfcler
jz+Yjxp1l1bkSgCoAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA+T2y1Np3XNprLWWo1RVXSbe09stBSN66TvfT
jvkEdN8nTlrfaNa7Z32DdXtg2RRkipPTei+oDFRKp8Bs9Tts9mYqZAjbf+LzlX4MEZXM9tmFSdKO
dyzqu3XZ+Ewebf1eJ6dNcftsx1DBx19ack9iASjZBW5rpPjnPSpQUDehGDeixFYz89t6qpActTol
6ddZ7RrKjc6dM15++l50DvKqOWdKmgdJVSucrZRHWVtc5W9g0Z2Sg1srAFSp1ocuXXsDfuvV4vH3
HDhz+nu8fPUWFXjPUaDbIAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAD4tqey1Nrm221Oqy6c+TYN1rpz3yOe
9pttEbrfaLezTFgNyyKKNy1ICgbkG5jpnKcyKBecxUkRmrz3VFZisxmZXTGaDJD812zlv4gI489r
/Mb118bActZTY62M6B595c7Hq1lOsTpMHn6pIvU9kyzi6yRWW9EUblUiY0G9QsI0E1uW34T4AnUd
JGWA46yi+v476yjWQRNLzpFnTJbKDvNKlcc1cojrK2X/AK5TTf0DrK2OUq80HQTK3sDV6cOX6vk0
nM/VB6/Bz3l68zpw8OdR6G4lAFQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAB8C1G9SJ3tx3uubat7c9atZb
WCCb2oNGSN6gAykrL9FFBPgg2VsqW5ntR0yvMTh1x0DcZduPDOPLvxxRuOOOn4jcR06Ecvyyx2sT
chrnI3pXTKDOjqtkrpnIOX5TrPp6LlOshrx6x7Z+f+PVcJ1mdJivP1/wmfbrc+24wg53NTZXpuPS
fwYOMla7fhO8g534ZjelZAkbY2dMv0GWJsWywVy1lz1l6LEayDh7lVmq1lFlgOkvolc5fa+wXKqV
zlbKDrKXSJf8LRE8uvbv4mf082/de/8A/nZ9RYPTwzqOhJ0NsgAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
APyetVIObQAQCgtGTtoAykjVZAzFTLc57dcYUcvxT8V6Jlv5/nQPPJV8Xf6dP/itVjjsoOvHPTtx
xHHOnbHQOmYuRGXTMVlljOnTosBy1GdOljOkEyOmZEydrzFDplyvo6By1n056j0anpzufaK4zPtc
zFfksFTOjqEntUgJ1HPcdtRz1lBxsJ9dLln5qCRtlZ1QC/G9VlBI2wk9gy59Oe8OzLOwebWUzuPR
vLlvIpK2X/HP3K3NB1lLUys3QXmdvoeDOpHh4J2+h4k6ixK9ADbIAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAD8iA51oAUGWtrOgJ8ayTpsBsjZm9tyrPQOvFPTrnpyw7Yzao2TtWMXtucO2JAM5nXxn59/FyN
6ET0rEbMrxkNbxx2zE5yvMVG9MsaSdqJsTculOogjMXINnxQ6jegBlibFsvxBzsT06aQis6jWyNo
Js7ZcrkLA1ysT1HXURqCueoTK7CQEflFjtYjUTBz6h0rpqCOjqKsYCbEby6pv0Hn3hH5seqyVOsd
iuGfTN1e8Vx3LAezwvfT6PDZHyvE5Jl7MeRIsqPdKPJnys/6ueTGtTHoHD/7EP8A7ENMdxwnkRs5
pTUx2ETklb+zRQyVqgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAD8lYx23jpzsYaTJ23psis+gT+Wfl0thIDn02el9
NzjsEyNmfbtx8TpngUTw47eriz1E4x+XbEAmWzPtecqmfYjM59NmF5i+vSo55yvOWyKkAkbBU+KM
6bAATfqk36g3LWZ+NtUBnZ2DS/GdloJvxkntTZEGdM6WAkUywE6c9R018Z12ixzmW9L6ARYjUdbE
WCudPyv8nSYOdjK6VNhgixPS01AZanWuka5Owbyajhufpd9tzgVzxiq/OnWRoOXWv9rZ3/rom/QZ
/wCv9b7/ANARvd/1Wd2X6hlgPTnn6jc+RI8fV/1l7NH0M+TFzyY+ZO5/VTV/1f0Y+pjnmnXOu3yu
Ll/P9d8+VJ/VlTHvHinmT/Xbi55r+rqY7jM3tqgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAD4HJx9uPJx9PbrLnyY7c2nhs
6rJXo5ONxuegMzt0zhPF9enix20J4+H9O2fG6/jtxZ/Ltn2Jrhjh6/jpnHX8dTrsNc//AI+1Zx06
SN6VE5ipGydNkAkVIRUgMFHUUS2VvUZYyNZawAGydsqyCp8ZZ2S9Hah0dKlamiOmL0i/VGyNZKqQ
GDemyAlnbdf1KAQALGdNb0ip6TZ7WzoNT16Tp0sc9+oKnSNU3vpx5NpaK3rpy3yJ1vtH1ButfomW
5wuQVmc9LkJGyCM6h0rqHQJ6ZZ/xfTAR0dKsYKyyMX0ywE2MsbQNR0dLsZYYIsTYvSLQZ1f9d+Dl
/H9ee6ZNA+jjy+v69fj8v/yR8zx+H99Po+Lx/iNRmu4DSAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAPmXKNZdqmxzaefeHHk4
3s1lz3kHi6/K+Pm/LrycfbhvHRo9nj8n7erD5OOS4e7xOX9ddtD1RUTiqVlQT2qQGSNCfVFT42fG
HYKGStAZr40BMnbemkAOuytl9AnplVampoqfBnbCje4wD0bIdnbFFSqnxGfq58BOkq2yRAka3o6B
nX/BUiSDKm3qK1fTzc3L0lWK3ydOPJyuXJyduWt91NVe+T2jWu0z2vOUVMz7XnPSs5XMiJkVI3ro
BnTRvQMFSHQJZVWMoJAAZfjU2gzTDVTaKq6/6nVZanVA1Uap3a7+Nxf/ACfwHnk7ejxuD9fx68+H
P8d+HhmP4uJqfG4fxHok6JOmtsgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAPngObSbE2OjLAcdZc947ejURcg8nJxpzyXje
reXHk4wenxOb9fa9eLL/AF8mauL6eng561KmPo5XHHg5JZ7rtL38VAV1GdeyjCRQB8Z22/EqN7O2
CaN7bKkUXbOmVnbEC0GyGBIyr69Jv1RgDIAAKlS3KwbtmfqrCRRoWsuoBb6cuTfX9RzcsnyvLy81
ZtXHXl5uv68vLyXVTvdtZJ2zqlvbZlsyuQE5y6ZjZFSAyRUAGU6rW9AmTpUh02A2RlimUE2Jv1V+
I0CazuGk2g21Npam0UtTaaqPdoN1azHer8rt4/HdX3Hu4/FzJFkS15fG4P19j3cHjzHS+PimXRqR
LSAKgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAD542wkc2iQsaAmxNjoywHLWXPeXfURqA828Jvefj0ay56yK548jedyPp
+HyzWPdfL3j+meXeNdT4sqWPuzWb8rXzPG8i3ruvfxcubn77aZdAnv4WKJtCfVJRPVb1WyN6QT1S
RtIoysboyoSKibTugq1N+s7ogqRvRK0wZ0dNDBOmZbpPcn1R0ZdSI1yZn9ebyeeT5U0ejfJn/Xm5
+br5Xl3z6qP3rX1nWsXy8tqLbW5na5lBOc9rzlsipAZIqRsjQZI0ACCp8BkjWdxsvYBPoLopmmJt
QNVz1W6056oM1U2mqi0VVqbb/Eyat+O/DxW33AcsZ1dfHq4ODu+478PBOvj0Y45Isiani4M5nbrJ
02DbIAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAADwsn2sHNpQyVoAAMv1FjpU0HOxNjpqJsBy1ly3iPTY57gPNdazfT
r4/PqbndZvMctSy+l0fb8bnzcfXbvv2+D4vNvPJ7vp9fx+fNxJ37alSx2n1U+JzqVU+FRrLS1lpI
FrO6xvRRgqM0QZG9Ny3owT1WL6LDBEq5U2E7UWy3pl1JHLk5s/6DprWZ9cPJ5syeq4+Tzzr1Xh5O
XVv1m1cdebn1/K4Xk3q+0zurxllTPddePJnLpnIpnK5CRUgjAACfRsgNAAbawAC1nYK7Zam1F0C7
pN0i6RrYL1pz3pOraz8at9CsvdvpfHx7tdeDgt+x7+Dhz+fcWRNeXg4P9j28XDmRecZio1ImsmZG
gqAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAPmtjRzaGysAUMlb3ACwATU2OlTQRY56jtY56gOOojeXXURYK42de
4vg5d517pqI1P8JR9Tx+eWSdvXjcs9PhcO9Z19e/xvI+dtSs499qU45ZqLkaQkV0SNTRnXpOl34i
wgZqpUKlUUM79M1voG66kct8uYjn58zPTwc/Nbr1WbVx6vI5516rwcvLq36ne9WpktrOq261f6Zz
e1Zy6ZyKnOV5yvOVyCJzlchIA2RpPgDOmyN6YAAAAAzstTbAbanVZrSNaBuqi6ZdJvv4K26Tc618
Vji1p6uDgs+wR5+Lh1Xt8fgknuO/DxST3HWZkakTUcfHmT46SSA0gAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAD53bUStlc2lDO2gAA3LWZ+tAZr61l+gm1Om36zXwEajnqOt+J1AcdfUV01E2IqLDGrm/W2MsUe
rxvI/P2vdw+Tnfx8TUv8rr4fJeO+61KmPuzXang4/Mn+vRxc80rLuyxmb2oEWHTbf68/P5Mx6Udd
8kzHl5/InXXbhz+T38rycu7q/WLVx05uW3X1y92smba6Yyiszl0zlWcrzkGYy6ZyZipAGwsJQazR
awFT42JipQalumABU2gruMtTanWgbrXpz1pm9OW99A6XTnvkjlvlcrvsHo/X6+O/j8V1Xl8b7H1f
Ak9EHTx+L8/Y9GcyfxUkG8ZAFAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAHx5pU04Z0vOnNt3lbK55qpR
HTsR22X/AKC5WolbL0CkttTaBr6m/GgJvxN+KsTYCNRNi6m/BUWJsWzQIsRvLppOqDnnvP8AXp8f
yfx/Xm3XLdXUfY4/On+r/wDvT/Xws6s/q88n/TTH2d+bOrO3z/L5v3r68uuS/wCp/fv6aO87v9Vn
Ljjk6dJzdIO+YvLzTm/6vPOD1ZXPry55/wDq884PS2VwzyrnJ2DpaxP6b+v/APAaJ77AU2Vk+MtB
XZantloNtTrTNac97BWtuetufJvpy3yA6cnJ048nJ2jWu0Wewbb3/TPojcg9Hi/Y+t4H8fJ8X7H1
vA/izp8e0BtkAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAB+czv26Z046z0TfTm09WdOkryce3bOgd5Wy
uWdLlB0lbK5yq7BaaztloKEdl0DbU6rLpGtA3VRqo1tF5BXTWunO8nSbrtN9iK1yIuzWUUG3SdNT
foM6LOmwvxRGmKABlrf6g2Nl6J8AVNNm+kHQOs5ulzn6/rzdRvQPXPI/6rPkf9eKfVSg9+OXv+um
d9vn55LF557Ae+WFryZ5+/66Z5OwdrUa0i6RvYqt7ceTkTvkcta7EbvaLWaYuDY0nxsgNnwn0kb/
AAHfxfr6vgT4+X4n19XwSdHsAbZAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAfn9Z7c946d7E6nbm088
vTpx7N4c76B6c6dM6ePG3bGwemVv6cZpv6FdLpl0i1lv/QXdI1ty3tF3QddcjneTtk9lgh32WHwt
BNAA18Rpd+JoJOu29NBmcs3F5TyAhN+rkZZ2olshIqQCRrY1BPUZYrqFgJkaRvUBnVbIS9tAuWdL
l7OoCZ6XN9MOoDf/AJGXXbOjoE1F+ulRr6omkjSQGyKkY2VBsCfW2A7+JPb6vhPleH9fV8P+LOle
sBtkAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAB8TU6RXXXSNRzbR9RvDofQebklynG69PJiVw5cdfBHT
j326TTyZtiv3Qd976Rd1zltXmdg2e2/lsnQB10lR0KkL0y0Q0m0tYDbWDegYyq6ZQblPIrKNgzPx
jctsBKp8Z0RRc+BPjZPSDBTKDBsjeoCRTLAYADZWsyvMBPVLHTqJ0Dnqpbr6wAO2dg1nZfjFF5rd
VGTVQerw77fW8N8fwb7j7HhfFnSvWA2yAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA+JaxErY5tqZ02f
VIIvaN5ldbEWA4bx0n8/8d7P9TcqmIzlU9FjBW9xqWz+hpay0L8ETayd9tbIDI3psKCRVTQE36pI
Nyja8p3ATn60AbIwn1QE+Nz8Y3INAAAgA3o6Bh02xnQNkXPjM/Wijnur1fTloRN+pUn+rAbI30zu
AX4wZ7BpZa3GdV24eDV/gK8DN7np9nw5ZHl8Hg667j6PHmRZEqwGkAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAfB1jUrJenv8ng9XqPFycWs3tzxozVyuM7i80VbNRs+AOeozpdSgmxOo6Ms9KOXVVPjbGA
dMrU36FAnRRA7KkG2sABKr8SDYnSonX0GAzsFSndZK3KjSAgpuWKnwAkG5+g0AUTZ/FFgJn1tp0w
Ga+ov1dRqiJrK21FqjWdsnuunHx2/ATJa68XDq/x28fxtd+4+j4vjyddwHk8Xxr37j6HB4+Z16ej
HHmT4qSRZE1OOPOfiwaQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABOsyz48/k8MufUeoslTB8bm8f
Utc5i5vt9nl45Z8ePyODv5GbGpXjlba3fFc/XO3pFbqsT32AovwgIkVYyzpFTfibF1KjOqzqqAT1
SxTNfAQNrBGWtgzsG3457q7XPkA7Tr6zutkUbn6vPxOVz4gNkJGgKZK0BuSRooAIAzsVqdVmqm0Q
1UVtrJO6CWzF1XXj4bqvVweJe5elHl4fH1a9/i+NZ13Hq8fx5J7j14xmT4uGuXDxZmZ6dpmRo0yA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAJ1mX+KAeTyuH9T08PN4+o+y48/H+v4zYsr4us/l
nb3eR41vfp5OTiuGWky/42VFvTZQWy/GSlAZ37amxFbfjD+F+CU7idVlrNVUZaSsZ2CrWEb0DEbX
Z0jkBP2tZn61RWV5RF5QaAAqMkVIDRUjNfUVkKM0oy1NpanVELU/Wydu3FwXVgOeOO6ejh8S29vV
4vi3/Hu4eKZnxZB5fG8br7Hu4sSZ+Kkk/jWpE06n+AKgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAACd57/AI8nk+P+vcj2lTF18Tn8e5/jz7/819vn4f28PkeL/wAZsV4ppXZycf5vSPiC
+6zus7p2K1mi1NojLUqvxICelAMnxfbJG9QGWue3Sxz1AQpljYoqfFZ+sn1WYg2KkJFfIKyTo7LW
AuVlTG2gWp1S1uM/oRFqscf6enh8b9/x6+HxOv4uDy+P4d1/Hu4PG/P8ejg4/wAuqyJqOLMzPiwa
QAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAc+Tj/AE6APDzeJ+vfTx8/B+f4
+1fjz83D+ozYuvh8k/N6Z29/k+N/eni5cXN+Mqi1nZZ7YDbWFnQAT6qQ66AAnsGa+oqtpBKsxK8q
NkVPSWyoLlGZV0DBt+JtBtvSfdJ7r0+Jwfu/Ac+Hj/f8e3x/F+eno4PF/P8AHp48flZE1z4eH8u0
nTRtAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAvwAc+Timo8vP4k6
7e5mp3OkxdfD8jh/N+PNqWX4+7z+PLO3h8nxuu7IzYr5/skXvFzr4i9/1BtrO2NnX+gdtlTW5Bm0
t0gBefiF5BvSpDM7igbmNqLWTu34DdWt4s3V+OvBxXWvj6HB4s6l6XB5/G8bv+PfwePMe18fFMus
WRLSeoA0gAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABZ258n
FNOgDw+T4ueu4+d5HDZfj728zUefn4M2M2LK+BZqX4PoeX4/XyPFvj1P4yqFRPVn07Bm0Sdq1WZU
OlT6w7QXK3upxnV/j0cHDq6ncBz48auvj2+N4/f2PT43jZ/Pdj044pIuGufD42ZO3fOZIqTqDWMg
CgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAyztoDnvi
zr68vl+Nnr1HuZrM19TF18HyOCz5Hm1mz7H3+fgzf4+f5fj331GcV83THXk4dT+JnFpBEldOPi1b
6jrxePq2en0vD8aSe4o8/i+Pb13H0eDx8zLpx8WZ/HSTpZE1OcyRQNIAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAyyVO+LN/iwHg8rx5b6jlnxv
fx9O5l+xn4z/AIzi64eNwZk9x3zmT42SRq4gAoAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAA//2Q==
EOT
};
# HTTP header
$response->{header}->{type} = 'image/gif';
$response->{header}->{expires} = '+3600s';
# HTTP message
$response->{message}->divert("message");
$response->{message}->append(decode_base64($jpg->{$name}));
$response->{message}->undivert(0);
}
sub viewgif ($) {
my ($name) = @_;
$name .= ".gif";
my $gif = {
"icon-dia.gif" => <<'EOT',
R0lGODlhCQAJAMIAAP////8AAP+ZAAAA/wCZAP///////////yH5BAEKAAcALAAAAAAJAAkAAAMS
eHqyLtAxGBW989KMbV+bxDgJADs=
EOT
"icon-dot.gif" => <<'EOT',
R0lGODlhCQAJAMIAAP////8AAP+ZAAAA/wCZAP///////////yH5BAEKAAcALAAAAAAJAAkAAAMR
eLqs8+3JJaur8OCsLZtNmAAAOw==
EOT
"icon-ok.gif" => <<'EOT',
R0lGODlhCQAJAMIAAP////8AAP+ZAAAA/wCZAP///////////yH5BAEKAAcALAAAAAAJAAkAAAMS
eLpKvMS9KGE8lTand7cVEyoJADs=
EOT
"icon-x.gif" => <<'EOT'
R0lGODlhCQAJAMIAAP////8AAP+ZAAAA/wCZAP///////////yH5BAEKAAcALAAAAAAJAAkAAAMS
GHHM+g1KFd9qB2J7M50dh3kJADs=
EOT
};
# HTTP header
$response->{header}->{type} = 'image/gif';
$response->{header}->{expires} = '+3600s';
# HTTP message
$response->{message}->divert("message");
$response->{message}->append(decode_base64($gif->{$name}));
$response->{message}->undivert(0);
}
sub viewprofileform ()
{
my ($html);
$html = '';
$html .= '<td>';
$html .= $cgi->start_form(-action => "$myurl?page=profile");
$html .= "<div>" . $cgi->submit('submit','profile') . "</div>";
$html .= $cgi->end_form;
$html .= '</td>';
return $html;
}
sub viewassociationform ()
{
my ($html);
$html = '';
$html .= '<td>';
$html .= $cgi->start_form(-action => "$myurl?page=association");
$html .= "<div>" . $cgi->submit('submit','association') . "</div>";
$html .= $cgi->end_form;
$html .= '</td>';
return $html;
}
sub viewloginform ()
{
my $html;
$html = '';
$html .= '<td>';
if ($cfg->{identification}->{mode} eq "ase" and defined $ase) {
$html .= $cgi->start_form(-action => $ase->url(-action => "login", -mode_during => "ase", -mode_after => "asecomeback"));
$html .= "<div>" . $cgi->submit('submit','login') . "</div>";
$html .= $cgi->end_form;
}
elsif ($cfg->{identification}->{mode} eq "basicauth") {
# nop
}
elsif ($cfg->{identification}->{mode} eq "naive") {
$html .= $cgi->start_form(-action => "$myurl?page=login");
$html .= "<div>" . $cgi->submit('submit','login') . "</div>";
$html .= $cgi->textfield(
-name => 'username',
-override => 1,
-size => 50,
-maxlength => 50,
-default => $cfg->{identification}->{default},
) . "\n";
$html .= $cgi->end_form;
}
elsif ($cfg->{identification}->{mode} eq "constant") {
# nop
}
else {
# nop, misconfigured
}
$html .= '</td>';
return $html;
}
sub viewasecomeback ()
{
my ($html, $username);
$username = &identifyusername();
if (defined $username) {
# updating heartbeat or creating username
#
$dbh->{AutoCommit} = 1;
$sql = sprintf("UPDATE reg_user SET heartbeat = now() WHERE ( username = %s );", $dbh->quote($username));
$rv = $dbh->do($sql);
if (not defined $rv) {
&viewprettyerror("updating user $username", prettydbi());
goto CUS;
}
elsif ($rv != 1) {
$sql = sprintf("INSERT INTO reg_user (username) VALUES (%s);", $dbh->quote($username));
$rv = $dbh->do($sql);
if (not defined $rv) {
&viewprettyerror("inserting user $username", prettydbi());
goto CUS;
}
elsif ($rv != 1) {
&viewprettyerror("creating user $username", prettydbi());
goto CUS;
}
}
}
# HTTP header
$response->{header}->{type} = 'text/html';
$response->{header}->{expires} = '+1s';
$response->{header}->{redirect} = "$myurl?page=login";
}
sub viewprettyerror ($$)
{
my ($marketingmessage, $technicaldetail) = @_;
my $html;
# HTTP header
$response->{header}->{type} = 'text/html';
$response->{header}->{expires} = '+1s';
$html = '';
$html .= "<body>";
$html .= "<h2>Sorry</h2>\n";
$html .= "<img src=\"?page=gif;name=icon-x\"> an internal <b>ERROR</b> occurred and prevents further processing.<br/>\n";
$html .= sprintf("<h2>Problem scope</h2>\n%s<br/>\n", $marketingmessage) if (defined $marketingmessage and $marketingmessage ne "");
$html .= sprintf("<h2>Technical details</h2>\n%s<br/>\n", $technicaldetail) if (defined $technicaldetail and $technicaldetail ne "");
$html .= "<h2>Please come back later and try again</h2>\nSorry for the inconvenience\n";
$html .= "</body>";
# HTTP message
$response->{message}->divert("message");
$response->{message}->append(&canvas($html));
$response->{message}->undivert(0);
}
sub prettydbi ()
{
my $msg;
$msg = $DBI::errstr;
$msg =~ s/[ ]*ERROR:?[ ]*//;
$msg =~ s/ for user.*$//;
return $msg;
}
sub viewemptypage ()
{
my ($html, $username);
# HTTP header
$response->{header}->{type} = 'text/html';
$response->{header}->{expires} = '+1s';
$html = '';
$html .= &viewhtmlhead(-menu);
$html .= &viewhtmltail();
# HTTP message
$response->{message}->divert("message");
$response->{message}->append(&canvas($html));
$response->{message}->undivert(0);
}
sub viewmainpage ()
{
my ($html, $username);
# HTTP header
$response->{header}->{type} = 'text/html';
$response->{header}->{expires} = '+1s';
$html = '';
$html .= &viewhtmlhead(-menu);
$html .= $cfg->{page}->{main};
$html .= &viewhtmltail();
# HTTP message
$response->{message}->divert("message");
$response->{message}->append(&canvas($html));
$response->{message}->undivert(0);
}
sub viewlogin ()
{
my ($html, $username, $fullname);
# HTTP header
$response->{header}->{type} = 'text/html';
$response->{header}->{expires} = '+1s';
$html = '';
$html .= &viewhtmlhead(-menu);
if ($cfg->{identification}->{mode} eq "ase" and defined $ase) {
# nop
}
elsif ($cfg->{identification}->{mode} eq "basicauth") {
# nop
}
elsif ($cfg->{identification}->{mode} eq "naive") {
$session->param('username', $cgi->param("username"));
}
elsif ($cfg->{identification}->{mode} eq "constant") {
# nop
}
else {
# nop, misconfigured
}
# identify username after login attempt
$username = &identifyusername();
# welcome user showing fullname (if available)
if (defined $username) {
$sql = sprintf("SELECT username, fullname FROM reg_user WHERE ( username = '%s' );", $username);
$rv = $dbh->selectall_hashref($sql, "username");
if (not $rv) {
die "ERROR:$0: DataBase error: ".$dbh->errstr."\n";
}
$fullname = $rv->{$username}->{fullname};
$html .= "<h2>Login successful</h2>\n";
$html .= "Welcome,<br/>\n" . (($fullname ne "") ? $fullname : $username) . "<br/>\n";
if ($cfg->{profile}->{token}->{uienable}) {
# create a user token if user does not yet have a user token
$sql = sprintf("SELECT count(userenable) FROM reg_token WHERE ( username = '%s' );", $username);
$rv = $dbh->selectrow_arrayref($sql);
if (not $rv) {
die "ERROR:$0: DataBase error: ".$dbh->errstr."\n";
}
if ($rv->[0] == 0) {
$html .= q{<p/>
Please note you can create a user token and use it as a replacement for
your (email) login when running <code>openpkg register</code>. This is
useful for writing scripts and documentation without revealing your
email address. All you need to do is visit the profile tab and issue a
new token. Tokens with additional capabilities like automatic instance
association without manual web interface usage are available if you
update your profile with additional information.
};
}
}
}
else {
$html .= "<h2>Login failed</h2>\n";
}
$html .= &viewhtmltail();
# HTTP message
$response->{message}->divert("message");
$response->{message}->append(&canvas($html));
$response->{message}->undivert(0);
}
sub viewlogoutform ()
{
my $html;
$html = '';
$html .= '<td>';
if ($cfg->{identification}->{mode} eq "ase" and defined $ase) {
$html .= $cgi->start_form(-action => $ase->url(-action => "logout", -mode_during => "ase", -mode_after => "logout"));
$html .= "<div>" . $cgi->submit('submit','logout') . "</div>";
$html .= $cgi->end_form;
}
elsif ($cfg->{identification}->{mode} eq "basicauth") {
# nop
}
elsif ($cfg->{identification}->{mode} eq "naive") {
$html .= $cgi->start_form(-action => "$myurl?page=logout");
$html .= "<div>" . $cgi->submit('submit','logout') . "</div>";
$html .= $cgi->end_form;
}
elsif ($cfg->{identification}->{mode} eq "constant") {
# nop
}
else {
# nop, misconfigured
}
$html .= '</td>';
return $html;
}
sub viewlogout ()
{
my ($html, $username);
# HTTP header
$response->{header}->{type} = 'text/html';
$response->{header}->{expires} = '+1s';
$html = '';
$html .= &viewhtmlhead(-menu);
if ($cfg->{identification}->{mode} eq "ase" and defined $ase) {
# nop
}
elsif ($cfg->{identification}->{mode} eq "basicauth") {
# nop
}
elsif ($cfg->{identification}->{mode} eq "naive") {
$session->clear('username');
}
elsif ($cfg->{identification}->{mode} eq "constant") {
# nop
}
else {
# nop, misconfigured
}
# identify username after logout attempt
$username = &identifyusername();
if (not defined $username) {
$html .= "<h2>Logged out</h2>\n";
}
else {
$html .= "<h2>Logout failed;</h2>\n";
}
$html .= &viewhtmltail();
# HTTP message
$response->{message}->divert("message");
$response->{message}->append(&canvas($html));
$response->{message}->undivert(0);
}
sub viewmainform ()
{
my $html;
$html = '';
$html .= '<td>';
$html .= $cgi->start_form(-action => "$myurl?page=main");
$html .= "<div>" . $cgi->submit('submit','main') . "</div>";
$html .= $cgi->end_form;
$html .= '</td>';
return $html;
}
sub viewdropxmlform ()
{
my $html;
$html = '';
$html .= '<td>';
$html .= $cgi->start_form(-action => "$myurl?page=dropxml");
$html .= "<div>" . $cgi->submit('submit','dropxml') . "</div>";
$html .= $cgi->end_form;
$html .= '</td>';
return $html;
}
sub execassociation ()
{
my $html;
my ($formstruct, $username, $headerout);
$html = '';
$username = &identifyusername();
if (not defined $username) {
$html .= "<h2>Access denied</h2>";
$html .= "Login to authenticate";
return $html;
}
$formstruct = {};
foreach my $k (keys %{$cgi->Vars()}) {
if ($k =~ m|^([^/]+)/([^/]+)/([^/]+)$|) {
$formstruct->{$1}->{$2}->{$3} = $cgi->param($k);
$cgi->delete(-name=>$k);
}
}
$headerout = 0;
foreach my $mode ("arrival", "active", "departure") {
if ($cgi->param("$mode/modify")) {
foreach my $k (keys %{$formstruct->{$mode}}) {
if ($formstruct->{$mode}->{$k}->{check} eq 'on') {
$html .= "<h3>Updating</h3>" unless($headerout++);
my $associate;
$associate = '';
$associate = "associated = 'true', " if ($mode eq "arrival");
$dbh->{AutoCommit} = 1;
$sql = sprintf("UPDATE reg_instance SET %s registry_desc = ? WHERE ( uuid_registry = ? );", $associate);
$sth = $dbh->prepare($sql);
$rv = $sth->execute($formstruct->{$mode}->{$k}->{registry_desc}, $k);
if (not defined $rv) {
$msg = $dbh->errstr;
$msg =~ s/[ ]*ERROR:?[ ]*//;
$html .= sprintf("<br/><img src=\"?page=gif;name=icon-x\"> <code><b>%s</b></code> ERROR: DataBase reports %s\n", $k, $msg);
next;
}
if ($rv != 1) {
$html .= sprintf("<br/><img src=\"?page=gif;name=icon-x\"> <code><b>%s</b></code> ERROR: update failed rv=$rv\n", $k);
next;
}
$html .= sprintf("<br/><img src=\"?page=gif;name=icon-ok\"> <code><b>%s</b></code> %s\n", $k, $formstruct->{$mode}->{$k}->{registry_desc});
}
}
}
}
$html .= "<hr/>\n" if($headerout);
$headerout = 0;
foreach my $mode ("arrival", "active", "departure") {
if ($cgi->param("$mode/delete")) {
foreach my $k (keys %{$formstruct->{$mode}}) {
if ($formstruct->{$mode}->{$k}->{check} eq 'on') {
$html .= "<h3>Deleting</h3>" unless($headerout++);
$dbh->{AutoCommit} = 1;
$sql = sprintf("DELETE FROM reg_instance WHERE ( uuid_registry = ? );");
$sth = $dbh->prepare($sql);
$rv = $sth->execute($k);
if (not defined $rv) {
$msg = $dbh->errstr;
$msg =~ s/[ ]*ERROR:?[ ]*//;
$html .= sprintf("<br/><img src=\"?page=gif;name=icon-x\"> <code><b>%s</b></code> ERROR: DataBase reports %s\n", $k, $msg);
next;
}
if ($rv != 1) {
$html .= sprintf("<br/><img src=\"?page=gif;name=icon-x\"> <code><b>%s</b></code> ERROR: deletion failed rv=$rv\n", $k);
next;
}
$html .= sprintf("<br/><img src=\"?page=gif;name=icon-ok\"> <code><b>%s</b></code> %s\n", $k, $formstruct->{$mode}->{$k}->{registry_desc});
}
}
}
}
if ($cgi->param("linked/unlink")) {
foreach my $k (keys %{$formstruct->{linked}}) {
if ($formstruct->{linked}->{$k}->{check} eq 'on') {
$html .= "<h3>Unlinking</h3>" unless($headerout++);
$dbh->{AutoCommit} = 1;
$sql = sprintf("UPDATE reg_instance SET registry_link = NULL WHERE ( uuid_registry = ? );");
$sth = $dbh->prepare($sql);
$rv = $sth->execute($k);
if (not defined $rv) {
$msg = $dbh->errstr;
$msg =~ s/[ ]*ERROR:?[ ]*//;
$html .= sprintf("<br/><img src=\"?page=gif;name=icon-x\"> <code><b>%s</b></code> ERROR: DataBase reports %s\n", $k, $msg);
next;
}
if ($rv != 1) {
$html .= sprintf("<br/><img src=\"?page=gif;name=icon-x\"> <code><b>%s</b></code> ERROR: unlinking failed rv=$rv\n", $k);
next;
}
$html .= sprintf("<br/><img src=\"?page=gif;name=icon-ok\"> <code><b>%s</b></code> %s\n", $k, $formstruct->{linked}->{$k}->{registry_desc});
}
}
}
$html .= "<hr/>\n" if($headerout);
return $html;
}
sub viewassociation ()
{
my ($html, $username);
# HTTP header
$response->{header}->{type} = 'text/html';
$response->{header}->{expires} = '+1s';
$html = '';
$html .= &viewhtmlhead(-menu);
$username = &identifyusername();
if (not defined $username) {
$html .= "<h2>Access denied</h2>";
$html .= "Login to authenticate";
}
else {
$html .= sprintf("<h2>Instances related to %s</h2>", $username);
$html .= "<hr/>\n";
$html .= &execassociation();
$html .= &condassociation("arrival", $username);
$html .= &condassociation("active", $username);
$html .= &condassociation("departure", $username);
$html .= &condassociation("linked", $username);
}
$html .= &viewhtmltail();
# HTTP message
$response->{message}->divert("message");
$response->{message}->append(&canvas($html));
$response->{message}->undivert(0);
}
sub profilemandatoriesok ($)
{
my ($username) = @_;
my $where;
$where = "";
for my $k (keys %{$cfg->{profile}->{mandatories}}) {
$where .= "AND NOT $k IS NULL AND $k != '' " if ($cfg->{profile}->{mandatories}->{$k});
};
$sql = qq{
SELECT 1 FROM reg_user WHERE (
username = ?
$where
AND (SELECT TRUE WHERE ((SELECT count(id) FROM reg_token WHERE ( username = ? )) < ?))
);
};
$sth = $dbh->prepare($sql);
$rv = $sth->execute($username, $username, $cfg->{profile}->{token}->{maxperuser});
if (not defined $rv) {
die "ERROR:$0: DataBase error: ".$dbh->errstr."\n";
}
return 1 if ($rv == 1);
return 0;
}
sub condassociation ($)
{
my ($mode, $username) = @_;
my ($html, $join, $where, $headline);
$html = '';
if ($mode eq "arrival") {
$join = "";
$where = sprintf("registry_user = %s AND i.associated = 'false'", $dbh->quote($username));
$headline = "Arrival - queue of registered instances waiting for association or deletion";
}
elsif ($mode eq "active") {
$join = "";
$where = sprintf("registry_user = %s AND i.associated = 'true' AND i.registry_date >= (now() - interval '150 days')", $dbh->quote($username));
$headline = "Active - associated instances eligible to use additional services e.g. FTP download";
}
elsif ($mode eq "departure") {
$join = "";
$where = sprintf("registry_user = %s AND i.associated = 'true' AND i.registry_date < (now() - interval '150 days')", $dbh->quote($username));
$headline = "Departure - queue of former active instances without recent re-registration";
}
elsif ($mode eq "linked") {
$join = "JOIN reg_token AS t ON i.registry_link = t.id";
$where = sprintf("registry_user != %s AND t.username = %s", $dbh->quote($username), $dbh->quote($username));
$headline = "Linked - foreign instances linked to my token";
}
else {
die;
}
$html .= "<table class=\"association\">\n";
$html .= "<tr>";
$html .= "<td colspan=\"5\">";
$html .= $cgi->start_form(-action => "$myurl?page=association");
$html .= "<h3>$headline</h3>";
$html .= "</td>";
$html .= "</tr>\n";
$sql = sprintf("SELECT uuid_registry, registry_date, registry_desc, registry_link FROM reg_instance AS i %s WHERE ( %s );", $join, $where);
$rv = $dbh->selectall_hashref($sql, "uuid_registry");
if (not $rv) {
die "ERROR:$0: DataBase error: ".$dbh->errstr."\n";
}
if ((keys %{$rv}) == "") {
$html .= "<tr>\n";
$html .= "<td>---empty---</td>";
$html .= "<td></td>";
$html .= "<td></td>";
$html .= "<td></td>";
$html .= "<td></td>";
$html .= "</tr>\n";
}
else {
$html .= "<tr>";
# checkallboxes
$html .= "<td>";
$html .= $cgi->checkbox(
-class => "checkbox",
-name => "$mode/checkallboxes",
-checked => ($mode eq "arrival" ? 1 : 0),
-label => "",
-onClick => "checkallboxes(this)"
) . "</td>";
$html .= "<td><b>date</b></td>";
$html .= "<td><b>registry</b></td>";
$html .= "<td><b>description</b></td>";
$html .= "<td><b>link</b></td>";
$html .= "</tr>\n";
my $row=1;
for my $i (sort keys %{$rv}) {
$html .= "<tr>";
# checkbox
$html .= "<td>";
$html .= $cgi->checkbox(
-class => "checkbox",
-id => "row-$row",
-name => "$mode/$i/check",
-checked => ($mode eq "arrival" ? 1 : 0),
-label => ""
) . "</td>";
# date
$html .= "<td>" . $rv->{$i}->{registry_date} . "</td>";
# registry
$html .= "<td><code><b>" . $i . "</b></code></td>";
# description
if ($mode ne "linked") {
$html .= "<td>";
$html .= $cgi->textfield(
-name => "$mode/$i/registry_desc",
-override => 1,
-size => 50,
-maxlength => 50,
-default => $rv->{$i}->{registry_desc},
-onchange => "checkrowbox('row-$row')"
) . "</td>";
}
else {
$html .= "<td><code>" . $rv->{$i}->{registry_desc} . "</code></td>";
}
# link
$html .= "<td><code>" . $rv->{$i}->{registry_link} . "</code></td>";
$html .= "</tr>\n";
$row++;
}
$html .= "<tr>";
$html .= "<td>→</td>";
$html .= "<td>";
if ($mode eq "linked") {
$html .= "<div>" . $cgi->submit("$mode/unlink",'unlink') . "</div>";
}
else {
$html .= "<div>" . $cgi->submit("$mode/delete",'delete') . "</div>";
}
$html .= "</td>";
$html .= "<td colspan=\"2\">";
if ($mode eq "arrival") {
$html .= $cgi->submit("$mode/modify",'modify and associate')
}
elsif ($mode ne "linked") {
$html .= $cgi->submit("$mode/modify",'modify and reload')
}
$html .= "</td>";
$html .= "<td>";
$html .= "</td>";
$html .= "</tr>\n";
}
$cgi->delete(-name=>'username');
$cgi->hidden(-name=>'username', -value => $username);
$html .= $cgi->end_form;
$html .= "</table>";
}
sub execprofile ()
{
my $html;
my ($formstruct, $username, $headerout, $changes);
$html = '';
$username = &identifyusername();
if (not defined $username) {
$html .= "<h2>Access denied</h2>";
$html .= "Login to authenticate";
return $html;
}
$formstruct = {};
foreach my $k (keys %{$cgi->Vars()}) {
if ($k =~ m|^([^/]+)/([^/]+)/([^/]+)$|) {
$formstruct->{$1}->{$2}->{$3} = $cgi->param($k);
$cgi->delete(-name=>$k);
}
}
$headerout = 0;
if ($cgi->param("profile/modify")) {
$changes = 0;
foreach my $k (keys %{$formstruct->{profile}->{username}}) {
my $v = $formstruct->{profile}->{username}->{$k};
$html .= "<h3>Updating Profile</h3>" unless($headerout++);
# We do not distinguish between empty string and
# undefined/NULL, but the database does. The logic here
# is: if our value is empty/undefined, we set the database
# record to empty in case it currently carries data. If
# the database record is NULL, we do not touch it. If
# our value is something not empty/undefined, we set the
# database record no matter if currently carries data or
# is NULL. The net result is that empty fields do not
# touch NULL records but they clear others and filled
# fields are set unconditionally. A db record may be left
# as NULL but once it has been set to something it will
# never return to the NULL state.
$dbh->{AutoCommit} = 1;
if ($v eq "") {
$sql = sprintf("UPDATE reg_user SET %s = ? WHERE ( username = ? AND %s != ? );", $k, $k);
}
else {
$sql = sprintf("UPDATE reg_user SET %s = ? WHERE ( username = ? AND ( %s IS NULL OR %s != ? ));", $k, $k, $k);
}
$sth = $dbh->prepare($sql);
$rv = $sth->execute($v, $username, $v);
if (not defined $rv) {
$msg = $dbh->errstr;
$msg =~ s/[ ]*ERROR:?[ ]*//;
$html .= sprintf("<br/><img src=\"?page=gif;name=icon-x\"> <code><b>%s</b></code> ERROR: DataBase reports %s\n", $k, $msg);
next;
}
if ($rv ne '0E0') {
if ($rv != 1) {
$html .= sprintf("<br/><img src=\"?page=gif;name=icon-x\"> <code><b>%s</b></code> ERROR: update failed rv=$rv\n", $k);
next;
}
$changes++;
$html .= sprintf("<br/><img src=\"?page=gif;name=icon-ok\"> <code><b>%s</b></code> %s\n", $k, $formstruct->{profile}->{username}->{$k});
};
}
if ($changes == 0) {
$html .= sprintf("<img src=\"?page=gif;name=icon-dot\"> <i>no changes</i>\n");
}
};
$html .= "<hr/>\n" if($headerout);
#
# token
#
my $mok = &profilemandatoriesok($username);
if ($cfg->{profile}->{token}->{uienable}) {
if ($cgi->param("token/new")) {
my $token;
my $uuid = new OSSP::uuid;
$uuid->make("v1") || die;
$token = $uuid->export("str");
undef $uuid;
$html .= "<h3>Creating Token</h3>";
if (( $formstruct->{token}->{new}->{linkenable} eq "on"
or $formstruct->{token}->{new}->{assocenable} eq "on"
) and not $mok) {
$html .= sprintf("<br/><img src=\"?page=gif;name=icon-x\"> ERROR: token features \"link\" and \"assoc\" unavailable because profile prerequisites not met\n");
}
else {
$dbh->{AutoCommit} = 1;
$sql = "INSERT INTO reg_token (id, username, description, userenable, linkenable, assocenable) VALUES ( ?, ?, ?, ?, ?, ? );";
$sth = $dbh->prepare($sql);
$rv = $sth->execute(
$token,
$username,
$formstruct->{token}->{new}->{description},
$formstruct->{token}->{new}->{userenable} eq "on" ? "TRUE" : "FALSE",
$formstruct->{token}->{new}->{linkenable} eq "on" ? "TRUE" : "FALSE",
$formstruct->{token}->{new}->{assocenable} eq "on" ? "TRUE" : "FALSE",
);
if (not defined $rv) {
$msg = $dbh->errstr;
$msg =~ s/[ ]*ERROR:?[ ]*//;
$html .= sprintf("<br/><img src=\"?page=gif;name=icon-x\"> <code><b>%s</b></code> ERROR: DataBase reports %s\n", $token, $msg);
}
elsif ($rv != 1) {
$html .= sprintf("<br/><img src=\"?page=gif;name=icon-x\"> <code><b>%s</b></code> ERROR: token creation failed rv=$rv\n", $token);
}
else {
$html .= sprintf("<br/><img src=\"?page=gif;name=icon-ok\"> <code><b>%s</b></code> %s\n", $token, $formstruct->{token}->{new}->{description});
$html .= "<hr/>\n";
}
}
}
$headerout = 0;
if ($cgi->param("token/modify")) {
foreach my $k (keys %{$formstruct->{token}}) {
next if $k eq "new";
if ($formstruct->{token}->{$k}->{check} eq 'on') {
$html .= "<h3>Updating Token</h3>" unless($headerout++);
if (( $formstruct->{token}->{$k}->{linkenable} eq "on"
or $formstruct->{token}->{$k}->{assocenable} eq "on"
) and not $mok) {
$html .= sprintf("<br/><img src=\"?page=gif;name=icon-x\"> ERROR: token features \"link\" and \"assoc\" unavailable because profile prerequisites not met\n");
}
else {
$dbh->{AutoCommit} = 1;
$sql = "UPDATE reg_token SET description = ?, userenable = ?, linkenable = ?, assocenable = ? WHERE ( id = ? AND username = ? );";
$sth = $dbh->prepare($sql);
$rv = $sth->execute(
$formstruct->{token}->{$k}->{description},
$formstruct->{token}->{$k}->{userenable} eq "on" ? "TRUE" : "FALSE",
$formstruct->{token}->{$k}->{linkenable} eq "on" ? "TRUE" : "FALSE",
$formstruct->{token}->{$k}->{assocenable} eq "on" ? "TRUE" : "FALSE",
$k,
$username
);
if (not defined $rv) {
$msg = $dbh->errstr;
$msg =~ s/[ ]*ERROR:?[ ]*//;
$html .= sprintf("<br/><img src=\"?page=gif;name=icon-x\"> <code><b>%s</b></code> ERROR: DataBase reports %s\n", $k, $msg);
next;
}
if ($rv != 1) {
$html .= sprintf("<br/><img src=\"?page=gif;name=icon-x\"> <code><b>%s</b></code> ERROR: update failed rv=$rv\n", $k);
next;
}
$html .= sprintf("<br/><img src=\"?page=gif;name=icon-ok\"> <code><b>%s</b></code> %s\n", $k, $formstruct->{token}->{$k}->{description});
}
}
}
}
$html .= "<hr/>\n" if($headerout);
$headerout = 0;
if ($cgi->param("token/delete")) {
foreach my $k (keys %{$formstruct->{token}}) {
next if $k eq "new";
if ($formstruct->{token}->{$k}->{check} eq 'on') {
$html .= "<h3>Deleting Token</h3>" unless($headerout++);
# unlink all occurences of token from reg_instance
$dbh->{AutoCommit} = 1;
$sql = sprintf("UPDATE reg_instance SET registry_link = NULL WHERE ( registry_link = ? );");
$sth = $dbh->prepare($sql);
$rv = $sth->execute($k);
if (not defined $rv) {
$msg = $dbh->errstr;
$msg =~ s/[ ]*ERROR:?[ ]*//;
$html .= sprintf("<br/><img src=\"?page=gif;name=icon-x\"> ERROR: DataBase reports %s\n", $msg);
next;
}
$dbh->{AutoCommit} = 1;
$sql = sprintf("DELETE FROM reg_token WHERE ( id = ? AND username = ? );");
$sth = $dbh->prepare($sql);
$rv = $sth->execute($k, $username);
if (not defined $rv) {
$msg = $dbh->errstr;
$msg =~ s/[ ]*ERROR:?[ ]*//;
$html .= sprintf("<br/><img src=\"?page=gif;name=icon-x\"> ERROR: DataBase reports %s\n", $msg);
next;
}
if ($rv eq '0E0') {
$html .= sprintf("<br/><img src=\"?page=gif;name=icon-x\"> <code><b>%s</b></code> ERROR: No such record.\n", $k);
next;
}
if ($rv != 1) {
$html .= sprintf("<br/><img src=\"?page=gif;name=icon-x\"> <code><b>%s</b></code> ERROR: deletion failed rv=$rv\n", $k);
next;
}
$html .= sprintf("<br/><img src=\"?page=gif;name=icon-ok\"> <code><b>%s</b></code> %s\n", $k, $formstruct->{token}->{$k}->{description});
}
}
}
$html .= "<hr/>\n" if($headerout);
}
return $html;
}
sub viewprofile ()
{
my ($html, $username);
# HTTP header
$response->{header}->{type} = 'text/html';
$response->{header}->{expires} = '+1s';
$html = '';
$html .= &viewhtmlhead(-menu);
$username = &identifyusername();
if (not defined $username) {
$html .= "<h2>Access denied</h2>";
$html .= "Login to authenticate";
}
else {
$html .= sprintf("<h2>Profile of %s</h2>", $username);
$html .= "<hr/>\n";
$html .= &execprofile();
$html .= &condprofile($username);
}
$html .= &viewhtmltail();
# HTTP message
$response->{message}->divert("message");
$response->{message}->append(&canvas($html));
$response->{message}->undivert(0);
}
sub condprofiletextfield ($$$)
{
my ($id, $long, $size) = @_;
$long =~ s/ / /g;
my $mandatory = $cfg->{profile}->{mandatories}->{$id};
my ($html);
$html = '';
$html .= "<tr>";
$html .= "<td>";
$html .= "<b>" if ($mandatory);
$html .= "$long";
$html .= "</b>" if ($mandatory);
$html .= "</td>";
$html .= "<td>";
$html .= $cgi->textfield(
-name => "profile/username/$id",
-override => 1,
-size => $size,
-maxlength => $size,
-default => $rv->{username}->{$id},
) . "</td>";
$html .= "</tr>\n";
return $html;
}
sub condprofiletextarea ($$$$)
{
my ($id, $long, $columns, $rows) = @_;
$long =~ s/ / /g;
my $mandatory = $cfg->{profile}->{mandatories}->{$id};
my ($html);
$html = '';
# text2
$html .= "<tr>";
$html .= "<td>";
$html .= "<b>" if ($mandatory);
$html .= "$long";
$html .= "</b>" if ($mandatory);
$html .= "</td>";
$html .= "<td>";
$html .= $cgi->textarea(
-name => "profile/username/$id",
-override => 1,
-columns => $columns,
-rows => $rows,
-maxlength => $columns,
-default => $rv->{username}->{$id},
) . "</td>";
$html .= "</tr>\n";
return $html;
}
sub condprofilepicklist ($$$$)
{
my ($id, $long, $values, $labels) = @_;
$long =~ s/ / /g;
my $mandatory = $cfg->{profile}->{mandatories}->{$id};
my ($html);
$html = '';
# text2
$html .= "<tr>";
$html .= "<td>";
$html .= "<b>" if ($mandatory);
$html .= "$long";
$html .= "</b>" if ($mandatory);
$html .= "</td>";
$html .= "<td>";
$html .= $cgi->popup_menu(
-name => "profile/username/$id",
-values => $values,
-labels => $labels,
-default => $rv->{username}->{$id},
) . "</td>";
$html .= "</tr>\n";
return $html;
}
sub condprofile ($)
{
my ($username) = @_;
my ($html);
$html = '';
$html .= "<table class=\"profile\">\n";
$html .= "<tr>";
$html .= "<td colspan=\"2\">";
$html .= $cgi->start_form(-action => "$myurl?page=profile");
$html .= "<h3>Profile</h3>";
$html .= "</td>";
$html .= "</tr>\n";
$sql = "SELECT cc, human FROM reg_countrycodes;";
$rv = $dbh->selectall_hashref($sql, "cc");
if (not $rv) {
die "ERROR:$0: DataBase error: ".$dbh->errstr."\n";
}
my @countrycodes;
my $countrycodeshuman = {};
push @countrycodes, "";
$countrycodeshuman->{""} = "";
for my $k (sort keys %{$rv}) {
push @countrycodes, $k;
$countrycodeshuman->{$k} = "$k = " . $rv->{$k}->{human};
}
$sql = "SELECT bc FROM reg_businesscategories;";
$rv = $dbh->selectall_hashref($sql, "bc");
if (not $rv) {
die "ERROR:$0: DataBase error: ".$dbh->errstr."\n";
}
my @businesscategories;
push @businesscategories, "";
for my $k (sort keys %{$rv}) {
push @businesscategories, $k;
}
$sql = sprintf("SELECT * FROM reg_user WHERE ( username = '%s' );", $username);
$rv = $dbh->selectall_hashref($sql, "username");
if (not $rv) {
die "ERROR:$0: DataBase error: ".$dbh->errstr."\n";
}
$rv->{username} = $rv->{$username};
my @timezones;
push @timezones, "";
for (my $i=-12; $i<=14; $i++) {
push @timezones, "UTC" . (($i<0 or $i>0) ? sprintf("%+05d", $i*100) : "");
};
$html .= &condprofiletextfield ("fullname", "Full Name", 50);
$html .= &condprofiletextfield ("organization", "Organization", 50);
$html .= &condprofilepicklist ("businesscategory", "Business Category", \@businesscategories);
$html .= &condprofiletextarea ("addresslabel", "Address Label", 30, 6);
$html .= &condprofilepicklist ("country", "Country", \@countrycodes, $countrycodeshuman);
$html .= &condprofilepicklist ("timezone", "Time Zone", \@timezones);
$html .= &condprofiletextfield ("telephonenumber", "Telephone Number", 50);
$html .= &condprofiletextfield ("mobilenumber", "Mobile Number", 50);
$html .= "<tr>";
$html .= "<td>→</td>";
$html .= "<td>";
$html .= "<div>" . $cgi->submit("profile/modify",'modify') . "</div>";
$html .= "</td>";
$html .= "</tr>\n";
$html .= $cgi->end_form;
$html .= "</table>";
#
# token
#
if ($cfg->{profile}->{token}->{uienable}) {
my $row = 0;
$html .= "<table class=\"token\">\n";
$html .= "<tr>";
$html .= "<td colspan=\"9\">";
$html .= $cgi->start_form(-action => "$myurl?page=profile");
$html .= "<h3>Token</h3>";
$html .= "</td>";
$html .= "</tr>\n";
my $mok = &profilemandatoriesok($username);
if (not $mok) {
$html .= "<td colspan=\"9\">";
$html .= "token features <i>link</i> and <i>assoc</i> unavailable because profile prerequisites not met\n";
$html .= "</td>";
}
$html .= "<tr>";
$html .= "<td></td>";
$html .= "<td><b>id</b></td>";
$html .= "<td><b>description</b></td>";
$html .= "<td colspan=\"2\"><b>user</b></td>";
$html .= "<td colspan=\"2\"><b>link</b></td>";
$html .= "<td colspan=\"2\"><b>assoc</b></td>";
$html .= "</tr>\n";
# new token
$html .= "<tr>";
# checkbox
$html .= "<td>";
$html .= $cgi->checkbox(
-class => "checkbox",
-id => "row-$row",
-name => "token/new/check",
-checked => 1,
-label => ""
) . "</td>";
# id
$html .= "<td><code><i>xxxxxxxx-xxxx-xxxx-xxxx-xxxxxxxxxxxx</i></code></td>";
# description
$html .= "<td>";
$html .= $cgi->textfield(
-name => "token/new/description",
-override => 1,
-size => 50,
-maxlength => 50,
-default => "unspecified",
-onchange => "checkrowbox('row-$row')"
) . "</td>";
# userenable
$html .= "<td>";
$html .= $cgi->checkbox(
-class => "checkbox",
-name => "token/new/userenable",
-checked => 1,
-label => "",
-onchange => "checkrowbox('row-$row')"
) . "</td>";
# usercount
$html .= "<td>0</td>";
# linkenable
$html .= "<td>";
$html .= $cgi->checkbox(
-class => "checkbox",
-name => "token/new/linkenable",
-checked => $mok,
-label => "",
-onchange => "checkrowbox('row-$row')"
) . "</td>";
# linkcount
$html .= "<td>0</td>";
# assocenable
$html .= "<td>";
$html .= $cgi->checkbox(
-class => "checkbox",
-name => "token/new/assocenable",
-checked => $mok,
-label => "",
-onchange => "checkrowbox('row-$row')"
) . "</td>";
# assoccount
$html .= "<td>0</td>";
$html .= "</tr>";
$html .= "<tr>";
$html .= "<td>→</td>";
$html .= "<td>";
$html .= "<div>" . $cgi->submit("token/new",'new') . "</div>";
$html .= "</td>";
$html .= "<tr>";
$html .= "<td colspan=\"7\">";
$html .= "</td>";
$html .= "</tr>\n";
$row++;
# delete/modify existing tokens
$sql = sprintf("SELECT * FROM reg_token WHERE ( username = '%s' );", $username);
$rv = $dbh->selectall_hashref($sql, "id");
if (not $rv) {
die "ERROR:$0: DataBase error: ".$dbh->errstr."\n";
}
my @keys = sort keys %{$rv};
if (@keys >= 1) {
for my $k (@keys) {
$html .= "<tr>";
# checkbox
$html .= "<td>";
$html .= $cgi->checkbox(
-id => "row-$row",
-class => "checkbox",
-name => "token/$k/check",
-checked => 0,
-label => ""
) . "</td>";
# id
$html .= "<td><code><b>" . $k . "</b></code></td>";
# description
$html .= "<td>";
$html .= $cgi->textfield(
-name => "token/$k/description",
-override => 1,
-size => 50,
-maxlength => 50,
-default => $rv->{$k}->{description},
-onchange => "checkrowbox('row-$row')"
) . "</td>";
# userenable
$html .= "<td>";
$html .= $cgi->checkbox(
-class => "checkbox",
-name => "token/$k/userenable",
-checked => $rv->{$k}->{userenable},
-label => "",
-onclick => "checkrowbox('row-$row')"
) . "</td>";
# usercount
$html .= "<td>" . $rv->{$k}->{usercount} . "</td>";
# linkenable
$html .= "<td>";
$html .= $cgi->checkbox(
-class => "checkbox",
-name => "token/$k/linkenable",
-checked => $rv->{$k}->{linkenable},
-label => "",
-onclick => "checkrowbox('row-$row')"
) . "</td>";
# linkcount
$html .= "<td>" . $rv->{$k}->{linkcount} . "</td>";
# assocenable
$html .= "<td>";
$html .= $cgi->checkbox(
-class => "checkbox",
-name => "token/$k/assocenable",
-checked => $rv->{$k}->{assocenable},
-label => "",
-onclick => "checkrowbox('row-$row')"
) . "</td>";
# assoccount
$html .= "<td>" . $rv->{$k}->{assoccount} . "</td>";
$html .= "</tr>\n";
$row++;
}
$html .= "<tr>";
$html .= "<td>→</td>";
$html .= "<td>";
$html .= "<div>" . $cgi->submit("token/delete",'delete') . "</div>";
$html .= "</td>";
$html .= "<td colspan=\"7\">";
$html .= "<div>" . $cgi->submit("token/modify",'modify') . "</div>";
$html .= "</td>";
$html .= "</tr>\n";
}
$html .= "<tr>";
$html .= "<td colspan=\"9\">";
$html .= "Legend:<br/>\n";
$html .= "<b>id</b> = the actual token to be used for <code>openpkg register</code> command<br/>\n";
$html .= "<b>description</b> = assume this information is visible to the public<br/>\n";
$html .= "<b>user</b> = token enabled for <code>--user=</code> replacement<br/>\n";
$html .= "<b>link</b> = token enabled for <code>--link=</code> usage<br/>\n";
$html .= "<b>assoc</b> = token enabled for automatic association (practically requires user or link)<br/>\n";
$html .= "<b>numbers</b> = show token and feature use count statistic<br/>\n";
$html .= "</td>";
$html .= "</tr>\n";
$cgi->delete(-name=>'username');
$html .= $cgi->hidden(-name=>'username', -value => $username);
$html .= $cgi->end_form;
$html .= "</table>";
};
}
sub execdropxml ()
{
my $html;
my $data;
$html = '';
if (&uao()) {
$html .= "<?xml version=\"1.0\" encoding=\"iso-8859-1\" standalone=\"no\"?>\n";
$html .= "<!DOCTYPE registry\n";
$html .= " PUBLIC \"-//OpenPKG//DTD OpenPKG Registry 0.0.1//EN\"\n";
$html .= " \"http://registry.openpkg.org/registry.dtd\" []>\n";
}
$data = $cgi->param("data");
if (not defined $data) {
if (&uao()) {
$html .= "<registry>\n";
$html .= "</registry>\n";
}
return($html)
}
$data =~ s|^[^<]*<|<|s; # cut off crap preceeding opening brace
$data =~ s|>[^>]*$|>|s; # cut off crap succeeding closing brace
if ($data eq "") {
if (&uao()) {
$html .= "<registry>\n";
$html .= "</registry>\n";
}
return($html)
}
# XMLin() requires the string being passed to start with '<'
# otherwise it is assumed the parameter is a filename to be
# read. We check for the closing brace at the end, too.
#
if (not $data =~ m|^<.*>$|s) {
if (&uao()) {
$html .= "<registry>\n";
$html .= "ERROR: not XML data\n";
$html .= "</registry>\n";
}
else {
$html .= sprintf("<br/><img src=\"?page=gif;name=icon-x\"> ERROR: not XML data\n");
}
return $html;
}
# Check DTD
# FIXME currently we just drop it!
$data =~ s|<!DOCTYPE registry[^>]*>||s;
my $ref = eval { local $SIG{__DIE__}; XMLin($data, ForceArray => 1, KeyAttr => [ "id" ]) };
if ($@) {
$msg = $@;
$msg =~ s| at \/.*$||; # hide program code file name and line
if (&uao()) {
$html .= "<registry>\n";
$html .= sprintf("ERROR: XML parser reports %s\n", $msg);
$html .= "</registry>\n";
}
else {
$html .= sprintf("<br/><img src=\"?page=gif;name=icon-x\"> ERROR: XML parser reports %s\n", $msg);
}
return $html;
}
# begin the transaction
#
$dbh->{AutoCommit} = 0;
eval { $rc = $dbh->begin_work };
if ($@) {
$msg = $@;
$msg =~ s/[ ]*ERROR:?[ ]*//;
if (&uao()) {
$html .= "<registry>\n";
$html .= sprintf("ERROR: at begin of transaction, DataBase reports %s\n", $msg);
$html .= "</registry>\n";
}
else {
$html .= sprintf("<br/><img src=\"?page=gif;name=icon-x\"> ERROR: at begin of transaction, DataBase reports %s\n", $msg);
}
return $html;
}
my $res = {};
my $commit = 1;
my @keys = keys %{$ref->{request}};
foreach my $k (@keys) {
$res->{$k} = "";
my $usertoken = "";
my $usertokenname = "";
my $usertokenenable = 0;
my $usertokenassoc = 0;
my $linktoken = "";
my $linktokenenable = 0;
my $linktokenassoc = 0;
# identify user by name or autouser enabled token
#
if ($ref->{request}->{$k}->{registry_user} =~ m/^[0-9a-f]{8}-[0-9a-f]{4}-[0-9a-f]{4}-[0-9a-f]{4}-[0-9a-f]{12}$/) {
$usertoken = $ref->{request}->{$k}->{registry_user};
# check token
#
if ($cfg->{profile}->{token}->{userenable}) {
$sql = "SELECT username, userenable, assocenable FROM reg_token WHERE ( id = ? );";
$sth = $dbh->prepare($sql);
$rv = $sth->execute($usertoken);
if (not defined $rv) {
$msg = $dbh->errstr;
$msg =~ s/[ ]*ERROR:?[ ]*//;
$res->{$k} .= sprintf("ERROR: DataBase reports %s;", $msg);
$commit = 0;
next;
}
elsif ($rv < 1) {
$res->{$k} .= sprintf("ERROR: token \"%s\" not found;", CGI::escapeHTML($usertoken));
$commit = 0;
next;
}
# check for token being enabled as user replacement and automatic association
#
($usertokenname, $usertokenenable, $usertokenassoc) = $sth->fetchrow_array;
if (not $usertokenenable) {
$res->{$k} .= sprintf("ERROR: token \"%s\" not enabled for user replacement;", $usertoken);
$commit = 0;
next;
}
# fake user
#
$ref->{request}->{$k}->{registry_user} = $usertokenname;
# update user token heartbeat and count
#
$sql = sprintf("UPDATE reg_token SET heartbeat = now(), usercount = usercount + 1 WHERE ( id = '%s' );", $usertoken);
$rv = $dbh->do($sql);
if (not defined $rv) {
$msg = $dbh->errstr;
$msg =~ s/[ ]*ERROR:?[ ]*//;
$res->{$k} .= sprintf("ERROR: DataBase reports %s;", $msg);
$commit = 0;
next;
}
elsif ($rv < 1) {
$res->{$k} .= sprintf("ERROR: token \"%s\" heartbeat update failed;", $usertoken);
$commit = 0;
next;
}
}
else {
$res->{$k} .= "ERROR: user token feature disabled;";
$commit = 0;
next;
}
}
else {
# check username by attempting to update heartbeat
#
my $username = $ref->{request}->{$k}->{registry_user};
$sql = sprintf("UPDATE reg_user SET heartbeat = now() WHERE ( username = %s );", $dbh->quote($username));
$rv = $dbh->do($sql);
if (not defined $rv) {
$msg = $dbh->errstr;
$msg =~ s/[ ]*ERROR:?[ ]*//;
$res->{$k} .= sprintf("ERROR: DataBase reports %s;", $msg);
$commit = 0;
next;
}
elsif ($rv < 1) {
$res->{$k} .= sprintf("ERROR: username \"%s\" not found;", CGI::escapeHTML($username));
$commit = 0;
next;
}
}
# identify link by name or autolink enabled token
#
if ($ref->{request}->{$k}->{registry_link} =~ m/^[0-9a-f]{8}-[0-9a-f]{4}-[0-9a-f]{4}-[0-9a-f]{4}-[0-9a-f]{12}$/) {
$linktoken = $ref->{request}->{$k}->{registry_link};
# check token
if ($cfg->{profile}->{token}->{linkenable}) {
$sql = "SELECT linkenable, assocenable FROM reg_token WHERE ( id = ? );";
$sth = $dbh->prepare($sql);
$rv = $sth->execute($linktoken);
if (not defined $rv) {
$msg = $dbh->errstr;
$msg =~ s/[ ]*ERROR:?[ ]*//;
$res->{$k} .= sprintf("ERROR: DataBase reports %s;", $msg);
$commit = 0;
next;
}
elsif ($rv < 1) {
$res->{$k} .= sprintf("ERROR: token \"%s\" not found;", CGI::escapeHTML($linktoken));
$commit = 0;
next;
}
# check for token being enabled as link and automatic association
#
($linktokenenable, $linktokenassoc) = $sth->fetchrow_array;
if (not $linktokenenable) {
$res->{$k} .= sprintf("ERROR: token \"%s\" not enabled for link usage;", $linktoken);
$commit = 0;
next;
}
# update link token heartbeat and count
#
$sql = sprintf("UPDATE reg_token SET heartbeat = now(), linkcount = linkcount + 1 WHERE ( id = '%s' );", $linktoken);
$rv = $dbh->do($sql);
if (not defined $rv) {
$msg = $dbh->errstr;
$msg =~ s/[ ]*ERROR:?[ ]*//;
$res->{$k} .= sprintf("ERROR: DataBase reports %s;", $msg);
$commit = 0;
next;
}
elsif ($rv < 1) {
$res->{$k} .= sprintf("ERROR: token \"%s\" heartbeat update failed;", $linktoken);
$commit = 0;
next;
}
}
else {
$res->{$k} .= "ERROR: link token feature disabled;";
$commit = 0;
next;
}
}
elsif ($linktoken ne "") {
$res->{$k} .= sprintf("ERROR: token \"%s\" syntax error;", $linktoken);
$commit = 0;
next;
}
# update instance
#
my $rowkey;
$rowkey = undef;
my ($fields, $fieldlist, $fieldbind, $fieldvals, $sth);
($sql, $fields, $fieldlist, $fieldbind, $fieldvals, $sth) = undef;
for my $field (sort keys %{$ref->{request}->{$k}}) {
if (not ref($ref->{request}->{$k}->{$field})) {
if ($field eq "uuid_registry") {
$rowkey = $ref->{request}->{$k}->{$field}
}
else {
$fieldlist = (defined $fieldlist ? $fieldlist . ", " : "") . $field . " = ?";
push @{$fieldvals}, $ref->{request}->{$k}->{$field};
}
}
else {
; # reserved - ignore unknown data structures
}
}
$sql = sprintf("UPDATE reg_instance SET registry_date = now(), %s WHERE ( uuid_registry = '%s' );", $fieldlist, $rowkey);
$sth = $dbh->prepare($sql);
$rv = $sth->execute(@{$fieldvals});
if (not defined $rv) {
$msg = $dbh->errstr;
$msg =~ s/[ ]*ERROR:?[ ]*//;
$res->{$k} .= sprintf("ERROR: DataBase reports %s;", $msg);
$commit = 0;
next;
}
elsif ($rv < 1) {
# insert instance
#
($sql, $fields, $fieldlist, $fieldbind, $fieldvals, $sth) = undef;
for my $field (sort keys %{$ref->{request}->{$k}}) {
if (not ref($ref->{request}->{$k}->{$field})) {
$fieldlist = (defined $fieldlist ? $fieldlist . ", " : "") . $field;
$fieldbind = (defined $fieldbind ? $fieldbind . ", " : "") . "?";
push @{$fieldvals}, $ref->{request}->{$k}->{$field};
#FIXME here we could check the validity of all fields with string 'uuid' in their names
}
else {
; # reserved - ignore unknown data structures
}
}
$sql = sprintf("INSERT INTO reg_instance (%s) VALUES (%s);", $fieldlist, $fieldbind);
$sth = $dbh->prepare($sql);
$rv = $sth->execute(@{$fieldvals});
if (not defined $rv) {
$msg = $dbh->errstr;
$msg =~ s/[ ]*ERROR:?[ ]*//;
$res->{$k} .= sprintf("ERROR: DataBase reports %s;", $msg);
$commit = 0;
next;
}
}
if ($rv < 1) {
$res->{$k} .= sprintf("ERROR: update and insert failed;");
$commit = 0;
next;
}
# maintain package and provides
#
my $package = $ref->{request}->{$k}->{package};
if ($cfg->{request}->{package} and defined $package) {
# prepare maintain package statement handles once and in advance
my $mpsth = {};
$mpsth->{wipe} = $dbh->prepare(sprintf("DELETE FROM inst_pkg_list WHERE (ipl_inst = ?);"));
$mpsth->{pkg_ids} = $dbh->prepare(sprintf("INSERT INTO pkg_ids SELECT ?, 'db' WHERE NOT EXISTS (SELECT 1 FROM pkg_ids WHERE (id = ?));"));
$mpsth->{nvr_names} = $dbh->prepare(sprintf("INSERT INTO nvr_names SELECT ? WHERE NOT EXISTS (SELECT 1 FROM nvr_names WHERE (name = ?));"));
$mpsth->{nvr_versions} = $dbh->prepare(sprintf("INSERT INTO nvr_versions SELECT ? WHERE NOT EXISTS (SELECT 1 FROM nvr_versions WHERE (version = ?));"));
$mpsth->{nvr_releases} = $dbh->prepare(sprintf("INSERT INTO nvr_releases SELECT ? WHERE NOT EXISTS (SELECT 1 FROM nvr_releases WHERE (release = ?));"));
$mpsth->{nvr} = $dbh->prepare(sprintf("INSERT INTO nvr SELECT ?, ?, ? WHERE NOT EXISTS (SELECT 1 FROM nvr WHERE (name = ? AND version = ? AND release = ?));"));
$mpsth->{nfv_names} = $dbh->prepare(sprintf("INSERT INTO nfv_names SELECT ? WHERE NOT EXISTS (SELECT 1 FROM nfv_names WHERE (name = ?));"));
$mpsth->{nfv_flags} = $dbh->prepare(sprintf("INSERT INTO nfv_flags SELECT ? WHERE NOT EXISTS (SELECT 1 FROM nfv_flags WHERE (flag = ?));"));
$mpsth->{nfv_versions} = $dbh->prepare(sprintf("INSERT INTO nfv_versions SELECT ? WHERE NOT EXISTS (SELECT 1 FROM nfv_versions WHERE (version = ?));"));
$mpsth->{nfv} = $dbh->prepare(sprintf("INSERT INTO nfv SELECT ?, ?, ? WHERE NOT EXISTS (SELECT 1 FROM nfv WHERE (name = ? AND flag = ? AND version = ?));"));
$mpsth->{nfvshort} = $dbh->prepare(sprintf("INSERT INTO nfv SELECT ?, NULL, NULL WHERE NOT EXISTS (SELECT 1 FROM nfv WHERE (name = ? AND flag IS NULL AND version IS NULL));"));
$mpsth->{inst_pkg_list} = $dbh->prepare(sprintf("INSERT INTO inst_pkg_list VALUES (?, ?, ?, ?, ?, ?, ?, ?);"));
$mpsth->{inst_pkg_list_short} = $dbh->prepare(sprintf("INSERT INTO inst_pkg_list VALUES (?, ?, ?, ?, ?, ?, NULL, NULL);"));
# wipe existing data for this instance, if any
$rv = $mpsth->{wipe}->execute($rowkey);
if (not defined $rv) {
$msg = $dbh->errstr;
$msg =~ s/[ ]*ERROR:?[ ]*//;
$res->{$k} .= sprintf("ERROR: DataBase reports %s;", $msg);
$commit = 0;
next PKG;
}
PKG: for my $pkg (keys %{$package}) {
# maintain package identifiers
$rv = $mpsth->{pkg_ids}->execute($pkg, $pkg);
if (not defined $rv) {
$msg = $dbh->errstr;
$msg =~ s/[ ]*ERROR:?[ ]*//; $msg =~ s/\n+/ /gs;
$res->{$k} .= sprintf("ERROR: DataBase reports %s;", $msg);
$commit = 0;
next PKG;
}
# maintain name, version, release and name-version-release
$rv = $mpsth->{nvr_names}->execute($package->{$pkg}->{name}, $package->{$pkg}->{name});
if (not defined $rv) {
$msg = $dbh->errstr;
$msg =~ s/[ ]*ERROR:?[ ]*//; $msg =~ s/\n+/ /gs;
$res->{$k} .= sprintf("ERROR: DataBase reports %s;", $msg);
$commit = 0;
next PKG;
}
$rv = $mpsth->{nvr_versions}->execute($package->{$pkg}->{version}, $package->{$pkg}->{version});
if (not defined $rv) {
$msg = $dbh->errstr;
$msg =~ s/[ ]*ERROR:?[ ]*//; $msg =~ s/\n+/ /gs;
$res->{$k} .= sprintf("ERROR: DataBase reports %s;", $msg);
$commit = 0;
next PKG;
}
$rv = $mpsth->{nvr_releases}->execute($package->{$pkg}->{release}, $package->{$pkg}->{release});
if (not defined $rv) {
$msg = $dbh->errstr;
$msg =~ s/[ ]*ERROR:?[ ]*//; $msg =~ s/\n+/ /gs;
$res->{$k} .= sprintf("ERROR: DataBase reports %s;", $msg);
$commit = 0;
next PKG;
}
$rv = $mpsth->{nvr}->execute($package->{$pkg}->{name}, $package->{$pkg}->{version}, $package->{$pkg}->{release}, $package->{$pkg}->{name}, $package->{$pkg}->{version}, $package->{$pkg}->{release});
if (not defined $rv) {
$msg = $dbh->errstr;
$msg =~ s/[ ]*ERROR:?[ ]*//; $msg =~ s/\n+/ /gs;
$res->{$k} .= sprintf("ERROR: DataBase reports %s;", $msg);
$commit = 0;
next PKG;
}
# assume at least a single provide for name = version-release, fake it if it is missing
if (not exists $package->{$pkg}->{provides}) {
$package->{$pkg}->{provides} = [
{
'version' => $package->{$pkg}->{name},
'flag' => '=',
'name' => $package->{$pkg}->{version} . "-" . $package->{$pkg}->{release}
}
];
}
foreach my $prv (@{$package->{$pkg}->{provides}}) {
# maintain name, flag, version, name-flag-version
$rv = $mpsth->{nfv_names}->execute($prv->{name}, $prv->{name});
if (not defined $rv) {
$msg = $dbh->errstr;
$msg =~ s/[ ]*ERROR:?[ ]*//; $msg =~ s/\n+/ /gs;
$res->{$k} .= sprintf("ERROR: DataBase reports %s;", $msg);
$commit = 0;
next PKG;
}
if ($prv->{flag} ne '' and $prv->{version} ne '') {
$rv = $mpsth->{nfv_flags}->execute($prv->{flag}, $prv->{flag});
if (not defined $rv) {
$msg = $dbh->errstr;
$msg =~ s/[ ]*ERROR:?[ ]*//; $msg =~ s/\n+/ /gs;
$res->{$k} .= sprintf("ERROR: DataBase reports %s;", $msg);
$commit = 0;
next PKG;
}
$rv = $mpsth->{nfv_versions}->execute($prv->{version}, $prv->{version});
if (not defined $rv) {
$msg = $dbh->errstr;
$msg =~ s/[ ]*ERROR:?[ ]*//; $msg =~ s/\n+/ /gs;
$res->{$k} .= sprintf("ERROR: DataBase reports %s;", $msg);
$commit = 0;
next PKG;
}
$rv = $mpsth->{nfv}->execute($prv->{name}, $prv->{flag}, $prv->{version}, $prv->{name}, $prv->{flag}, $prv->{version});
if (not defined $rv) {
$msg = $dbh->errstr;
$msg =~ s/[ ]*ERROR:?[ ]*//; $msg =~ s/\n+/ /gs;
$res->{$k} .= sprintf("ERROR: DataBase reports %s;", $msg);
$commit = 0;
next PKG;
}
}
else {
$rv = $mpsth->{nfvshort}->execute($prv->{name}, $prv->{name});
if (not defined $rv) {
$msg = $dbh->errstr;
$msg =~ s/[ ]*ERROR:?[ ]*//; $msg =~ s/\n+/ /gs;
$res->{$k} .= sprintf("ERROR: DataBase reports %s;", $msg);
$commit = 0;
next PKG;
}
}
# maintain inst_pkg_list
if ($prv->{flag} ne '' and $prv->{version} ne '') {
$rv = $mpsth->{inst_pkg_list}->execute($rowkey, $pkg, $package->{$pkg}->{name}, $package->{$pkg}->{version}, $package->{$pkg}->{release}, $prv->{name}, $prv->{flag}, $prv->{version});
if (not defined $rv) {
$msg = $dbh->errstr;
$msg =~ s/[ ]*ERROR:?[ ]*//; $msg =~ s/\n+/ /gs;
$res->{$k} .= sprintf("ERROR: DataBase reports %s;", $msg);
$commit = 0;
next PKG;
}
}
else {
$rv = $mpsth->{inst_pkg_list_short}->execute($rowkey, $pkg, $package->{$pkg}->{name}, $package->{$pkg}->{version}, $package->{$pkg}->{release}, $prv->{name});
if (not defined $rv) {
$msg = $dbh->errstr;
$msg =~ s/[ ]*ERROR:?[ ]*//; $msg =~ s/\n+/ /gs;
$res->{$k} .= sprintf("ERROR: DataBase reports %s;", $msg);
$commit = 0;
next PKG;
}
}
}
}
}
# automatic association of instance to user based on token
#
if ($usertokenassoc or $linktokenassoc) {
if (not $usertokenassoc and $usertoken eq "" and $linktokenassoc) {
$res->{$k} .= sprintf("ERROR: user token is mandatory for link token association");
$commit = 0;
next;
}
if ($cfg->{profile}->{token}->{assocenable}) {
if ($cfg->{profile}->{token}->{assocrequestpackagemandatory} and not defined $package) {
$res->{$k} .= sprintf("ERROR: association using token failed because mandatory package data was not posted");
$commit = 0;
next;
}
$sql = "UPDATE reg_instance SET associated = 'TRUE' WHERE ( uuid_registry = ? );";
$sth = $dbh->prepare($sql);
$rv = $sth->execute($k);
if (not defined $rv) {
$msg = $dbh->errstr;
$msg =~ s/[ ]*ERROR:?[ ]*//; $msg =~ s/\n+/ /gs;
$res->{$k} .= sprintf("ERROR: DataBase reports %s;", $msg);
$commit = 0;
next;
}
if ($rv != 1) {
$res->{$k} .= sprintf("ERROR: association using token failed;");
$commit = 0;
next;
}
# update token association count
#
if ($usertokenenable) {
$sql = sprintf("UPDATE reg_token SET assoccount = assoccount + 1 WHERE ( id = '%s' );", $usertoken);
$rv = $dbh->do($sql);
if (not defined $rv) {
$msg = $dbh->errstr;
$msg =~ s/[ ]*ERROR:?[ ]*//;
$res->{$k} .= sprintf("ERROR: DataBase reports %s;", $msg);
$commit = 0;
next;
}
elsif ($rv < 1) {
$res->{$k} .= sprintf("ERROR: token \"%s\" association counter failed;", $usertoken);
$commit = 0;
next;
}
}
elsif ($linktokenenable) {
$sql = sprintf("UPDATE reg_token SET assoccount = assoccount + 1 WHERE ( id = '%s' );", $linktoken);
$rv = $dbh->do($sql);
if (not defined $rv) {
$msg = $dbh->errstr;
$msg =~ s/[ ]*ERROR:?[ ]*//;
$res->{$k} .= sprintf("ERROR: DataBase reports %s;", $msg);
$commit = 0;
next;
}
elsif ($rv < 1) {
$res->{$k} .= sprintf("ERROR: token \"%s\" association counter failed;", $linktoken);
$commit = 0;
next;
}
}
}
else {
$res->{$k} .= sprintf("ERROR: association using token failed because feature is disabled;");
$commit = 0;
next;
}
}
# success with instance
$res->{$k} = "DONE" if ($res->{$k} eq "");
}
if ($commit == 1) {
eval { $dbh->commit };
if ($@) {
$msg = $@;
$msg =~ s/[ ]*ERROR:?[ ]*//;
if (&uao()) {
$html .= "<registry>\n";
$html .= sprintf("ERROR: commit transaction failed, DataBase reports %s\n", $msg);
$html .= "</registry>\n";
}
else {
$html .= sprintf("<br/><img src=\"?page=gif;name=icon-x\"> ERROR: commit transaction failed, DataBase reports %s\n", $msg);
}
return($html)
}
$cgi->delete(-name=>'data');
}
else {
eval { $dbh->rollback };
if ($@) {
$msg = $@;
$msg =~ s/[ ]*ERROR:?[ ]*//;
if (&uao()) {
$html .= "<registry>\n";
$html .= sprintf("ERROR: rollback transaction failed, DataBase reports %s\n", $msg);
$html .= "</registry>\n";
}
else {
$html .= sprintf("<br/><img src=\"?page=gif;name=icon-x\"> ERROR: rollback transaction failed, DataBase reports %s\n", $msg);
}
return($html)
}
}
$html .= "<registry>\n" if (&uao());
foreach my $k (@keys) {
$msg = $res->{$k};
if ($msg eq "DONE") {
$msg = $ref->{request}->{$k}->{registry_desc};
if ($commit == 1) {
if (&uao()) {
$html .= sprintf(" <response id=\"%s\" done=\"yes\">%s</response>\n", $k, $msg);
}
else {
$html .= sprintf("<br/><img src=\"?page=gif;name=icon-ok\"> <b>%s</b> %s\n", $k, $msg);
}
}
else {
if (&uao()) {
$html .= sprintf(" <response id=\"%s\" done=\"no\">IGNORED: %s</response>\n", $k, $msg);
}
else {
$html .= sprintf("<br/><img src=\"?page=gif;name=icon-dot\"> <b>%s</b> IGNORED: %s\n", $k, $msg);
}
}
}
else {
if (&uao()) {
$html .= sprintf(" <response id=\"%s\" done=\"no\">%s</response>\n", $k, $msg);
}
else {
$html .= sprintf("<br/><img src=\"?page=gif;name=icon-x\"> <b>%s</b> %s\n", $k, $msg);
}
}
}
$html .= "</registry>\n" if (&uao());
return($html);
}
sub viewdropxml ()
{
my $html;
# HTTP header
$response->{header}->{type} = &uao() ? 'plain/text' : 'text/html';
$response->{header}->{expires} = '+1s';
$html = '';
if (not &uao()) {
$html .= &viewhtmlhead(-menu);
}
$html .= &execdropxml();
if (not &uao()) {
if (defined $cgi->param("data")) {
$html .= "<h2>Correct registration data below</h2>";
}
else {
$html .= "<h2>Paste registration data below</h2>";
}
$html .= " <table class=\"menu\">\n";
$html .= " <tr>\n";
$html .= " <td>\n";
$html .= $cgi->start_form(-action => "$myurl?page=dropxml");
$html .= "<div>" . $cgi->textarea(
-name => 'data',
-columns => 80,
-rows => 15,
-default => '',
) . "</div>\n";
$html .= "<div>" . $cgi->submit('submit','register') . "</div>";
$html .= $cgi->end_form;
$html .= " </td>\n";
$html .= " </tr>\n";
$html .= " </table>\n";
$html .= &viewhtmltail();
}
# HTTP message
$response->{message}->divert("message");
$response->{message}->append(&uao() ? $html : &canvas($html));
$response->{message}->undivert(0);
}
sub printjscheckallboxes ()
{
my $js;
$js = <<'EOT';
<script type="text/javascript"><!--
function checkallboxes(me) {
var value=me.checked;
var form=me.form;
var items=form.length;
var i;
for(i=0; i<items; i++) {
if(form[i].type=='checkbox') {
form[i].checked=value;
}
}
}
function checkrowbox(box) {
document.getElementById(box).checked=1;
}
//--></script>
EOT
return $js;
}
sub canvas ($)
{
my ($page) = @_;
my ($head, $body, $canvas);
$head = '';
$head = $1 if ($page =~ m|<head[^>]*>(.*)</head>|s);
$body = '';
$body = $1 if ($page =~ m|<body[^>]*>(.*)</body>|s);
(undef, undef, $canvas) = &fetchurlcached($cfg->{canvas}->{url});
if (not defined $canvas or $canvas eq "") {
$canvas =
"<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\"\n" .
" \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">\n" .
"<html>\n" .
" <head>\n" .
" <title>OpenPKG registry</title>\n" .
$cfg->{canvas}->{mark_head} . "\n" .
" </head>\n" .
" <body class=\"registry\">\n" .
$cfg->{canvas}->{mark_body} . "\n" .
" </body>\n" .
"</html>\n";
}
$canvas =~ s|$cfg->{canvas}->{mark_head}|$head|;
$canvas =~ s|$cfg->{canvas}->{mark_body}|$body|;
return $canvas;
}
sub fetchurlcached ($)
{
my ($url) = @_;
my ($content_type, $expires, $content);
undef $content;
if ($url ne "") {
($content_type, $expires, $content) = &getcache($url) if ($cfg->{canvas}->{urlcache});
($content_type, $expires, $content) = &fetchurl($url) if (not defined $content);
&setcache($url, $content_type, $expires, $content) if (defined $content and $cfg->{canvas}->{urlcache});
}
return $content_type, $expires, $content;
}
sub getcache ($)
{
my ($url) = @_;
my ($content_type, $expires, $content, $rv, $sth);
($content_type, $expires, $content) = undef;
return if (not defined $dbs);
# invalidate expired records
$rv = $dbs->do("DELETE FROM cache WHERE ( expires <= ? );", undef, time()) or die $dbs->errstr();
# dig in the cache
$sth = $dbs->prepare("SELECT content_type, expires, content FROM cache WHERE url = ?;") or die $dbs->errstr();
$sth->execute($url) or die $dbs->errstr();
$rv = $sth->fetchrow_hashref;
$content_type = $rv->{content_type};
$expires = $rv->{expires};
$content = $rv->{content};
return $content_type, $expires, $content;
}
sub setcache ($$$$)
{
my ($url, $content_type, $expires, $content) = @_;
return if (not defined $dbs);
$expires = time() + 600 if (not defined $expires);
$rv = $dbs->do("INSERT INTO cache (url, content_type, expires, content) VALUES (?, ?, ?, ?);",
undef,
$url, $content_type, $expires, $content) or die $dbs->errstr();
}
sub fetchurl ($)
{
my ($url) = @_;
my ($content_type, $expires, $content, $rv, $sth);
($content_type, $expires, $content) = undef;
my $response;
use HTTP::Response;
use Socket;
use Net::HTTP;
use LWP::UserAgent;
my $ua = new LWP::UserAgent;
$ua->agent("openpkg-$progname/$progvers");
$ua->timeout(20);
$ua->max_size(1*1024*1024);
$ua->max_redirect(2);
$ua->protocols_allowed([ 'http', 'https']);
$response = $ua->get($url);
if ($response->is_success) {
$content_type = $response->content_type;
$expires = $response->expires;
$content = $response->content;
}
return $content_type, $expires, $content;
}
sub identifyusername ()
{
my $username;
$username = undef;
if ($cfg->{identification}->{mode} eq "ase" and defined $ase) {
$username = $ase->attr("client-login-name") if ($ase->login);
}
elsif ($cfg->{identification}->{mode} eq "basicauth") {
$username = $ENV{'REMOTE_USER'};
}
elsif ($cfg->{identification}->{mode} eq "naive") {
$username = $session->param('username') if ($session);
}
elsif ($cfg->{identification}->{mode} eq "constant") {
$username = $cfg->{identification}->{default};
}
else {
# nop, misconfigured
}
$username = undef if ($username =~ m|^[ ]+$|);
return $username;
}