From 6fa39011a07aaaf20b99929965ba93df8a81cdbb Mon Sep 17 00:00:00 2001 From: Claudio Sacerdoti Coen Date: Mon, 22 Jul 2002 17:34:34 +0000 Subject: [PATCH] First version of hxsp (new version of UWOBO implemented in Perl by Alessandro Barzanti using the bindings to libxml and libxslt). --- helm/hxsp/config | 47 ++ helm/hxsp/hxsp.pl | 1250 ++++++++++++++++++++++++++++ helm/hxsp/make.pl | 17 + helm/hxsp/msg/error.en | 45 + helm/hxsp/msg/error.it | 46 + helm/hxsp/msg/message.en | 96 +++ helm/hxsp/msg/message.it | 96 +++ helm/hxsp/splitted/0.init.p.pl | 30 + helm/hxsp/splitted/1.globvars.p.pl | 95 +++ helm/hxsp/splitted/2.start.p.pl | 49 ++ helm/hxsp/splitted/3.daemon.p.pl | 131 +++ helm/hxsp/splitted/4.hash.p.pl | 150 ++++ helm/hxsp/splitted/5.libxslt.p.pl | 174 ++++ helm/hxsp/splitted/6.commands.p.pl | 215 +++++ helm/hxsp/splitted/7.qsparse.p.pl | 172 ++++ helm/hxsp/splitted/8.strrep.p.pl | 76 ++ helm/hxsp/splitted/9.load.p.pl | 149 ++++ helm/hxsp/tpl/ok.tpl | 5 + helm/hxsp/tpl/operror.tpl | 5 + helm/hxsp/tpl/synerror.tpl | 6 + 20 files changed, 2854 insertions(+) create mode 100644 helm/hxsp/config create mode 100644 helm/hxsp/hxsp.pl create mode 100644 helm/hxsp/make.pl create mode 100644 helm/hxsp/msg/error.en create mode 100644 helm/hxsp/msg/error.it create mode 100644 helm/hxsp/msg/message.en create mode 100644 helm/hxsp/msg/message.it create mode 100644 helm/hxsp/splitted/0.init.p.pl create mode 100644 helm/hxsp/splitted/1.globvars.p.pl create mode 100644 helm/hxsp/splitted/2.start.p.pl create mode 100644 helm/hxsp/splitted/3.daemon.p.pl create mode 100644 helm/hxsp/splitted/4.hash.p.pl create mode 100644 helm/hxsp/splitted/5.libxslt.p.pl create mode 100644 helm/hxsp/splitted/6.commands.p.pl create mode 100644 helm/hxsp/splitted/7.qsparse.p.pl create mode 100644 helm/hxsp/splitted/8.strrep.p.pl create mode 100644 helm/hxsp/splitted/9.load.p.pl create mode 100644 helm/hxsp/tpl/ok.tpl create mode 100644 helm/hxsp/tpl/operror.tpl create mode 100644 helm/hxsp/tpl/synerror.tpl diff --git a/helm/hxsp/config b/helm/hxsp/config new file mode 100644 index 000000000..87cd74d8a --- /dev/null +++ b/helm/hxsp/config @@ -0,0 +1,47 @@ +######################################################################## +######################################################################## +# +# Main config file for hxsp +# Author: Alessandro Barzanti (barzu@libero.it) +# +######################################################################## +######################################################################## + +######################################################################## +# Working path of hxsp +######################################################################## +#working_path = helm/puwobo +working_path = helm/uwobo +#working_path = helm/hxsp + +######################################################################## +# Port to use for hxsp +######################################################################## +port = 8080 + +######################################################################## +# Interface language +######################################################################## +language = IT +#language = EN + +######################################################################## +# Use complete command description on syntax error if ON +######################################################################## +all_usage_synerr = OFF +#all_usage_synerr = ON + +######################################################################## +# Include XIncludes on the fly if ON +######################################################################## +expand_xinc = OFF +#expand_xinc = ON + +######################################################################## +# Max Depth of the DOM tree while parsing +######################################################################## +max_depth = 1000 + +######################################################################## +######################################################################## +######################################################################## diff --git a/helm/hxsp/hxsp.pl b/helm/hxsp/hxsp.pl new file mode 100644 index 000000000..14fd24361 --- /dev/null +++ b/helm/hxsp/hxsp.pl @@ -0,0 +1,1250 @@ +#!/usr/bin/perl + +################################################################################################# +################################################################################################# +################################################################################################# +# +# H.X.S.P. V 1.0 +# T S T R +# T L Y O +# P T E C +# S E +# H S +# E S +# E O +# T R +# +################################################################################################# +################################################################################################# +################################################################################################# + +use HTTP::Daemon; +use HTTP::Status; +use HTTP::Request; +use LWP::UserAgent; +use URI::Escape; +use CGI; +use FindBin; +use XML::LibXML; +use XML::LibXSLT; +use IO; + +################################################################################################# +################################################################################################# +################################################################################################# +# Global Variables +################################################################################################# +################################################################################################# +################################################################################################# + +# Version number +my $ver ="1.0"; + +# Working path of hxsp (loaded from config) +my $working_path; + +# Interface language (loaded from config) +my $language; + +# Port to use for hxsp (loaded from config) +my $port; + +# Use complete command description on syntax error if ON (loaded from config) +my $all_usage_synerr; + +# Include XIncludes on the fly if ON (loaded from config) +my $expand_xinc; + +# Max Depth of the DOM tree while parsing +my $max_depth; + +# Message sent when hxsp was called without commands (loaded from message.##) +my $home_message; + +# Message sent when hxsp was called with the help command (loaded from message.##) +my $help_message; + +# Message sent when a stylesheet is added (loaded from message.##) +my $s_add; + +# Message sent when a stylesheet is reloaded (loaded from message.##) +my $s_reload; + +# Message sent when a stylesheet is removed (loaded from message.##) +my $s_remove; + +# Message to print the stylesheet status for list command (loaded from message.##) +my $list; + +# Message sent when the list command was called +# and there is no stylesheet loaded (loaded from message.##) +my $empty; + +# Message sent after "home_message" when hxsp was called without commands +# and sent after "help_message" when hxsp was called with the help command +# and after all syntax errors if "all_usage_synerr" is set ON (loaded from message.##) +my $all_usage; + +# All the following syntax errors messages are used #only# if "all_usage_synerr" is set OFF + +# Message sent on help syntax errors (loaded from message.##) +my $help_usage; + +# Message sent on add syntax errors (loaded from message.##) +my $add_usage; + +# Message sent on remove syntax errors (loaded from message.##) +my $remove_usage; + +# Message sent on list syntax errors (loaded from message.##) +my $list_usage; + +# Message sent on reload syntax errors (loaded from message.##) +my $reload_usage; + +# Message sent on apply syntax errors (loaded from message.##) +my $apply_usage; + +# The error hash contains the error messages to call in case of syntax +# or operative errors, the keys are defined by the left value of each line in error## +my %error; + +# load ok template +my $ok_tpl; + +# load operror template +my $operror_tpl; + +# load synerror template +my $synerror_tpl; + +# This is the data structure to store the loaded stylesheets (hash of array) +# [0] :Styleseet URI , [1] : Loaded styleseet +my %stylesheet_hash; + +# This is a hash for fast duplicate uri detection +my %by_name; + +################################################################################################# +################################################################################################# +################################################################################################# +# Starting Operations +################################################################################################# +################################################################################################# +################################################################################################# + +# chdir to the directory of this perl script +chdir $FindBin::Bin; + +# load CONFIG +load_conf(); + +# initialize the objects to use LibXML and LibXSLT +my $parser = XML::LibXML->new(); +my $xslt = XML::LibXSLT->new(); + +# initialize the LibXML callbacks to load uri's +XML::LibXML->callbacks(\&match_uri,\&open_uri,\&read_uri,\&close_uri); + +# include XIncludes on the fly if required +if ($expand_xinc eq "ON") { $parser->expand_xinclude( 1 ); } + +# initialize the hxsp as HTTP::Daemon +my $d = new HTTP::Daemon LocalPort => $port; + +# get the complete working url of hxsp +my $puwobo_url = $d->url().$working_path; + +# set the working path to be comparable with url->path +$working_path = "/". $working_path; + +# load messages +load_messages(); + +# load error +load_err(); + +# load templates +load_templates(); + +# print starting information on console +print qq{ +hxsp v$ver active at: + Language is $language + On syntax error usage of every command is $all_usage_synerr + Include XIncludes on the fly is $expand_xinc; +}; + +################################################################################################# +################################################################################################# +# HTTP::Daemon Operations +################################################################################################# +################################################################################################# + +# do not accumulate defunct processes +$SIG{CHLD} = "IGNORE"; +$SIG{USR1} = \&listen; # sent by the child to make the parent read the pipe + +pipe LIST_CHILD, TELL_PARENT; +pipe LIST_PARENT, TELL_CHILD; +TELL_PARENT->autoflush(1); +TELL_CHILD->autoflush(1); + + +sub listen { + my $res; + my $query = ; + if ($query =~ /^add /) { + $query =~ s/^add //; + chomp($query); + $res = add($query); + } + elsif ($query =~ /^reload /) { + $query =~ s/^reload //; + chomp($query); + $res = reload($query); + } + elsif ($query =~ /^remove /) { + $query =~ s/^remove //; + chomp($query); + $res = remove($query); + } + print TELL_CHILD "$res\n"; + print TELL_CHILD "____\n"; # end of response +} + +while (my $c = $d->accept) #connect +{ + if (fork() == 0) #start new concurrent process + { + while (my $r = $c->get_request) #get http request + { + if ($r->method eq 'GET' && + ($r->url->path eq $working_path or $r->url->path eq $working_path."/"))#start dir + { + my $response = new HTTP::Response; + $response->header('Cache-Control' => 'no-cache','Pragma' => "no-cache",'Expires' => '0'); + $response->content(home($r->url->query)); + $c->send_response($response); + } + elsif ($r->method eq 'GET' && $r->url->path eq $working_path."/help")#usage + { + my $response = new HTTP::Response; + $response->header('Cache-Control' => 'no-cache','Pragma' => "no-cache",'Expires' => '0'); + $response->content(help($r->url->query)); + $c->send_response($response); + } + elsif ($r->method eq 'GET' && $r->url->path eq $working_path."/add")#add + { + my $response = new HTTP::Response; + kill(USR1,getppid()); # ask the parent to read the pipe + my $qs = $r->url->query; + print TELL_PARENT "add $qs\n"; + my $in; + while (($in = ) ne "____\n") { + $res .= $in; + } + chomp($res); + $response->header('Cache-Control' => 'no-cache','Pragma' => "no-cache",'Expires' => '0'); + $response->content($res); + $c->send_response($response); + } + elsif ($r->method eq 'GET' && $r->url->path eq $working_path."/remove")#remove + { + my $response = new HTTP::Response; + kill(USR1,getppid()); # ask the parent to read the pipe + my $qs = $r->url->query; + print TELL_PARENT "remove $qs\n"; + my $in; + my $res=""; + while (($in = ) ne "____\n") { + $res .= $in; + } + chomp($res); + $response->content($res); + $response->header('Cache-Control' => 'no-cache','Pragma' => "no-cache",'Expires' => '0'); + $c->send_response($response); + } + elsif ($r->method eq 'GET' && $r->url->path eq $working_path."/reload")#reload + { + my $response = new HTTP::Response; + kill(USR1,getppid()); # ask the parent to read the pipe + my $qs = $r->url->query; + print TELL_PARENT "reload $qs\n"; + my $in; + my $res=""; + while (($in = ) ne "____\n") { + $res .= $in; + } + chomp($res); + $response->content($res); + $response->header('Cache-Control' => 'no-cache','Pragma' => "no-cache",'Expires' => '0'); + $c->send_response($response); + } + elsif ($r->method eq 'GET' && $r->url->path eq $working_path."/list")#list + { + my $response = new HTTP::Response; + $response->header('Cache-Control' => 'no-cache','Pragma' => "no-cache",'Expires' => '0'); + $response->content(list($r->url->query)); + $c->send_response($response); + } + elsif ($r->method eq 'GET' && $r->url->path eq $working_path."/apply")#apply + { + my %headers; + my $response = new HTTP::Response; + $response->content(apply($r->url->query,\%headers)); + $response->header(%headers); + $c->send_response($response); + } + else #wrong command or not working_path + { + $c->send_error(RC_FORBIDDEN) + } + } + $c->close; + undef($c); + exit; + } # fork +} + +################################################################################################# +################################################################################################# +################################################################################################# +# Stylesheet hash check subrutines +################################################################################################# +################################################################################################# +################################################################################################# + +################################################################################################# +# sub addcheckvalues +# Usage: addcheckvalues($key,$uri); +# Returns: error message or 0 if no errors found +# Do: check if key and uri are already loaded +# Used by: addvalues +# Uses : err_replace +################################################################################################# +sub addcheckvalues +{ + my $ac_key = shift(@_); + my $ac_uri = shift(@_); + if (exists $stylesheet_hash{$ac_key}) + { + return err_replace($error{"add_dup_key"},$ac_key,$ac_uri,""); + } + elsif (exists $by_name{$ac_uri}) + { + return err_replace($error{"add_dup_value"},$ac_key,$ac_uri,$by_name{$ac_key}); + } + else { return 0; } +} +################################################################################################# + +################################################################################################# +# sub recheckvalues +# Usage: recheckvalues($key); +# Returns: error message or 0 if no errors found +# Do: check if key are loaded +# Used by: remove, reloadvalues +# Uses : err_replace +################################################################################################# +sub recheckvalues +{ + my $re_key = shift(@_); + if (not exists $stylesheet_hash{$re_key}) + { + return err_replace($error{"re_inv_key"},$re_key,"",""); + } + else { return 0; } +} +################################################################################################# + +################################################################################################# +# sub applycheckvalues +# Usage: applycheckvalues(\@keys); +# Returns: error message or 0 if no errors found +# Do: check if keys in @keys are loaded +# Used by: remove, reloadvalues +# Uses : err_replace +################################################################################################# +sub applycheckvalues +{ + my $applykeys_ptr = shift(@_); + foreach $applykey (@$applykeys_ptr) + { + if (not exists $stylesheet_hash{$applykey}) + { + return err_replace($error{"apply_inv_key"},$applykey,"",""); + } + } + return 0; +} +################################################################################################# + +################################################################################################# +################################################################################################# +################################################################################################# +# Stylesheet hash modify subrutines +################################################################################################# +################################################################################################# +################################################################################################# + +################################################################################################# +# sub addvalues +# Usage: if add_halt_on_errors is ON addvalues($key,$uri,@added); +# else addvalues($key,$uri) +# Returns: error message or 0 on success, +# if add_halt_on_errors is ON return all the added keys on @added +# Do: add the values to the stylesheet hash +# Used by: add +# Uses : addcheckvalues, loadstyle +################################################################################################# +sub addvalues +{ + my $av_key = shift(@_); + my $av_uri = shift(@_); + my $av_stylesheet; #parsed stylesheet to be placed in hash + if (my $err = addcheckvalues($av_key,$av_uri)) { return $err; } + elsif (my $err = loadstyle($av_key, $av_uri, $av_stylesheet)) { return $err; } + else + { + $stylesheet_hash{$av_key}[0]=$av_uri; + $stylesheet_hash{$av_key}[1]=$av_stylesheet; + $by_name{$av_uri}=$av_key; + return 0; + } +} +################################################################################################# + +################################################################################################# +# sub removevalues +# Usage: removevalues($key); +# Returns: message +# Do: remove the key specified and relative values from the stylesheet hash +# Used by: remove, do_remove +# Uses : ok_replace +################################################################################################# +sub removevalues +{ + my $cr_key = shift(@_); + my $cr_uri = $stylesheet_hash{$cr_key}[0]; + delete $stylesheet_hash{$cr_key}; + delete $by_name{$cr_uri}; + return ok_replace("$s_remove\n",$cr_key,$cr_uri); +} +################################################################################################# + +################################################################################################# +# sub reloadvalues +# Usage: if add_halt_on_errors is ON reloadvalues($key.\%reloaded); +# else reloadvalues($key); +# Returns: error message or 0 on success, +# if add_halt_on_errors is ON return the old stylesheets in %reloaded +# Do: reload the stlylesheet with the key specified +# Used by: do_reload +# Uses : recheckvalues, loadstyle +################################################################################################# +sub reloadvalues +{ + my $rv_key = shift(@_); + my $rv_uri = $stylesheet_hash{$rv_key}[0]; + my $rv_stylesheet; #parsed stylesheet to be placed in hash + if (my $err = recheckvalues($rv_key)) { return $err; } + elsif (my $err = loadstyle($rv_key, $rv_uri, $rv_stylesheet)) { return $err; } + else + { + $stylesheet_hash{$rv_key}[1] = $rv_stylesheet; + return 0; + } +} +################################################################################################# + +################################################################################################# +################################################################################################# +################################################################################################# +# LibXML LIBXSLT access subrutines +################################################################################################# +################################################################################################# +################################################################################################# + +################################################################################################# +# sub loadstyle +# Usage: loadstyle($key,$uri,$stylesheet); +# Returns: error message or 0 on success, +# parsed stylesheet in $stylesheet +# Do: parse the stylesheet at the given uri +# Used by: addvalues , reloadvalues +# Uses : err_replace, parser_error_replace +################################################################################################# +sub loadstyle +{ + my $ls_key= shift(@_); + my $ls_uri= shift(@_); + my $uncatched = ""; + my $line = ""; + my $style_doc; + pipe P, STDERR; + STDERR->autoflush(1); + eval { $style_doc = $parser->parse_file($ls_uri); }; + print STDERR "____\n"; + while(($line =

) ne "____\n") { $uncatched .= $line; } + close P; + + if ($@ or $uncatched ne "") + { + return err_replace($error{"add_xml_error"},$ls_key,$ls_uri,parser_error_replace($@.$uncatched)); + } + else + { + pipe P, STDERR; + STDERR->autoflush(1); + $uncatched = ""; + $line = ""; + eval { $_[0] = $xslt->parse_stylesheet($style_doc); }; + print STDERR "____\n"; + while(($line =

) ne "____\n") { $uncatched .= $line; } + close P; + if ($@ or $uncatched ne "") + { + return err_replace($error{"add_xslt_error"},$ls_key,$ls_uri,parser_error_replace($@.$uncatched)); + } + else {return 0} + } +} + +sub load_xml_doc +{ + my $xmluri = shift(@_); + my $uncatched = ""; + my $line = ""; + pipe P, STDERR; + STDERR->autoflush(1); + eval { $_[0] = $parser->parse_file($xmluri); }; + print STDERR "____\n"; + while(($line =

) ne "____\n") { $uncatched .= $line; } + close P; + if ($@ or $uncatched ne "") + { + return err_replace($error{"apply_xml_error"},"",$xmluri,parser_error_replace($@.$uncatched)); + } + else {return 0} +} + +sub apply_style +{ + my $k = shift(@_); + my $params_ptr = shift(@_); + my %params = XML::LibXSLT::xpath_to_string(%$params_ptr); + my $pippo; + my $uncatched = ""; + my $line = ""; + pipe P, STDERR; + STDERR->autoflush(1); + XML::LibXSLT->max_depth($max_depth); + eval { $_[0] = $stylesheet_hash{$k}[1]->transform($_[0],%params); }; + print STDERR "____\n"; + while(($line =

) ne "____\n") { $uncatched .= $line; } + close P; + if ($@ or $uncatched ne "") + { + my $e_r = parser_error_replace($@.$uncatched); + return err_replace($error{"apply_xslt_error"},$k,$stylesheet_hash{$k}[0],$e_r); + } + else {return 0} +} +sub get_results +{ + my $k = shift(@_); + my $results = shift(@_); + my $retval; + my $uncatched = ""; + my $line = ""; + pipe P, STDERR; + STDERR->autoflush(1); + eval { $retval = $stylesheet_hash{$k}[1]->output_string($results); }; + print STDERR "____\n"; + while(($line =

) ne "____\n") { $uncatched .= $line; } + close P; + if ($@ or $uncatched ne "") + { + my $e_r = parser_error_replace($@.$uncatched); + return operror_print(err_replace($error{"apply_xslt_out_error"},"","",$e_r)); + } + else { return $retval; } +} +sub get_results_prop +{ + my $result = shift(@_); + my $retval; + my $uncatched = ""; + my $line = ""; + pipe P, STDERR; + STDERR->autoflush(1); + eval { $retval = $result->toString; }; + print STDERR "____\n"; + while(($line =

) ne "____\n") { $uncatched .= $line; } + close P; + if ($@ or $uncatched ne "") + { + my $e_r = parser_error_replace($@.$uncatched); + return operror_print(err_replace($error{"apply_xslt_out_error"},"","",$e_r)); + } + else { return $retval; } +} + +sub get_results_html +{ + my $result = shift(@_); + my $retval; + my $uncatched = ""; + my $line = ""; + pipe P, STDERR; + STDERR->autoflush(1); + eval { $retval = $result->toStringHTML();}; + print STDERR "____\n"; + while(($line =

) ne "____\n") { $uncatched .= $line; } + close P; + if ($@ or $uncatched ne "") + { + my $e_r = parser_error_replace($@.$uncatched); + return operror_print(err_replace($error{"apply_xslt_out_error"},"","",$e_r)); + } + else { return $retval; } +} + +sub decode +{ + my $result = shift(@_); + my $enc = shift(@_); + my $retval; + my $uncatched = ""; + my $line = ""; + pipe P, STDERR; + STDERR->autoflush(1); + eval { $retval = decodeFromUTF8($enc, $result);}; + print STDERR "____\n"; + while(($line =

) ne "____\n") { $uncatched .= $line; } + close P; + if ($@ or $uncatched ne "") + { + my $e_r = parser_error_replace($@.$uncatched); + return operror_print(err_replace($error{"apply_xslt_out_error"},"","",$e_r)); + } + else { return $retval; } +} +################################################################################################# + +################################################################################################# +################################################################################################# +################################################################################################# +# Commands subrutines +################################################################################################# +################################################################################################# +################################################################################################# + +################################################################################################# +# sub add +# Usage: add($http_query); +# Returns: values for HTTP::Response +# Do: add stylesheet(s) to hash +# Used by: daemon +# Uses : addparsequery, addvalues, ok_replace, +# ok_print, synerror_print, operror_print +################################################################################################# +sub add +{ + my $http_query = shift(@_); # querystring + my $cont =""; # return value + my @binds; #values of binds passed via querystring + my $err; # error string + if ($err = addparsequery($http_query,\@binds)) { return synerror_print($err,$add_usage); } + else + { + foreach my $bind (@binds) + { + my ($a_key , $e_uri) = split(/,/,$bind,2); + my $une_uri = uri_unescape($e_uri); + if ($err = addvalues($a_key,$une_uri)) { $cont .= "$err\n"; } + else { $cont .= ok_replace("$s_add\n",$a_key,$une_uri); } + }#foreach + return ok_print($cont); + } +} +################################################################################################# + +################################################################################################# +# sub remove +# Usage: remove($http_query); +# Returns: values for HTTP::Response +# Do: remove stylesheet(s) from hash +# Used by: daemon +# Uses : reparsequery, getkeys, recheckvalues, removevalues, +# ok_print, synerror_print, operror_print +################################################################################################# +sub remove +{ + my $http_query = shift(@_); # querystring + my $rem_keys; + my $cont=""; + my $err; + if ($http_query eq "") + { + my $i=0; + foreach my $rem_key (keys %stylesheet_hash) + { + $cont .= removevalues($rem_key); + $i++; + } + if ($i==0) { return operror_print($error{"re_no_sl"}); } + } + elsif ($err = reparsequery($http_query,$rem_keys)){return synerror_print($err,$remove_usage);} + else + { + foreach my $rem_key (split (/,/,$rem_keys)) + { + if (my $err = recheckvalues($rem_key)) { $cont .= "$err\n"; } + else { $cont .= removevalues($rem_key); } + } + } + return ok_print($cont); +} +################################################################################################# + +################################################################################################# +# sub reload +# Usage: remove($http_query); +# Returns: values for HTTP::Response +# Do: remove stylesheet(s) from hash +# Used by: daemon +# Uses : reparsequery, getkeys, recheckvalues, removevalues, +# ok_print, synerror_print, operror_print +################################################################################################# +sub reload #reload stylesheet(s) from hash +{ + my $http_query = shift(@_); + my $rel_keys; + my @rel_k; + my $dr_cont = ""; + if ($http_query eq "") + { + my $i=0; + foreach my $key (keys %stylesheet_hash) + { + if (my $err = reloadvalues($key)) { return $dr_cont .= $err; } + else {$dr_cont .= ok_replace("$s_reload\n",$key,$stylesheet_hash{$key}[0]);} + $i++; + } + if ($i==0) { return operror_print($error{"re_no_sl"}); } + } + elsif ($err = reparsequery($http_query,$rel_keys)){return synerror_print($err,$reload_usage);} + else + { + foreach my $key (split (/,/,$rel_keys)) + { + if (my $err = reloadvalues($key)) { return $dr_cont .= $err; } + else {$dr_cont .= ok_replace("$s_reload\n",$key,$stylesheet_hash{$key}[0]);} + } + } + return ok_print($dr_cont); +} +################################################################################################# + +sub apply #apply stylesheets +{ + my $http_query = shift(@_); + my $headers_ptr = shift(@_); + my $xmluri; + my @applykeys; + my %app_param; + my %app_prop; + my $results; + my $lastkey; + my $enc; + + if (my $err=applyparsequery($http_query,\@applykeys,\%app_param,\%app_prop,$xmluri)) + { + return synerror_print($err,$apply_usage); + } + elsif (my $err=applycheckvalues(\@applykeys)) { return operror_print($err); } + elsif (my $err=load_xml_doc($xmluri,$results)) { return operror_print($err); } + #apply + foreach my $applykey (@applykeys) + { + $lastkey=$applykey; + if (my $err=apply_style($applykey,\%{$app_param{$applykey}},$results)) + { + return operror_print($err); + } + }#foreach + my $i=0; + while (my ($n, $v) = each %app_prop) + { + if (($n eq "method") or ($n eq "METHOD")) + { + if ($v eq 'html') { $headers_ptr->{'Content-Type'}='text/html'; } + elsif ($v eq 'text') { $headers_ptr->{'Content-Type'}='text/plain'; } + else { $headers_ptr->{'Content-Type'}='text/xml'; } + } + if (($n eq "encoding") or ($n eq "ENCODING")) + { + $headers_ptr->{'Content-Encoding'}=$v; + if ($v ne "UTF-8") { $enc = $v; } + } + if (($n eq "media-type") or ($n eq "MEDIA_TYPE") or ($n eq "MEDIA-TYPE")) + { + $headers_ptr->{'Content-Type'}=$v; + } + $i++; + } + if ($i == 0) + { + %$headers_ptr= ('Cache-Control' => 'no-cache','Pragma' => "no-cache",'Expires' => '0'); + return get_results($lastkey,$results); + } + else + { + my $result; + $headers_ptr->{'Cache-Control'} = 'no-cache'; + $headers_ptr->{'Pragma'} = "no-cache"; + $headers_ptr->{'Expires'} = '0'; + if ($headers_ptr->{'Content-Type'} eq 'text/html') + { + $result = get_results_html($results); + } + else + { + $result = get_results_prop($results); + if ($enc) + { + $result = decode($result,$enc); + } + } + return $result; + } +} + +sub list #list all the stylesheet loaded +{ + my $cont=""; + my $ind = 0; + foreach $key (keys %stylesheet_hash) + { + $cont .= ok_replace("$list\n",$key,$stylesheet_hash{$key}[0]); + $ind++; + } + if ($ind > 0) { return ok_print($cont); } + else { return ok_print($empty); } +} + +sub home #return Dispay active +{ + if ($_[0] ne "") { return synerror_print($error{"home_qs"},$all_usage); } + else { + return ok_print($home_message.$all_usage); + } +} + +sub help #return html help +{ + if ($_[0] ne "") { return synerror_print($error{"help_qs"},$help_usage); } + return ok_print($help_message.$all_usage); +} + +################################################################################################# +################################################################################################# +# Subrutines to get parameters for commands from Query String (query string parsing) +################################################################################################# +################################################################################################# + +sub add_comma_analysis +{ + my $bind = shift(@_); + my ($l , $r) = split(/,/,$bind,2); + if (index($bind ,",") == -1) { return $error{"add_no_sep"}; } + elsif (index($r ,",") != -1) { return $error{"add_many_sep"}; } + elsif (($l eq "") or ($r eq "")) { return $error{"add_null_bind"}; } + else { return 0; } +} +## +#usage: +#addparsequery($querystring,\@binds) +#returns $errcode; +sub addparsequery +{ + my $query = shift(@_); + my $value_ptr = shift(@_); + if ($query eq "") { return $error{"add_no_bind"}; } + else + { + foreach my $params (split(/&/,$query)) + { + my ($k , $v) = split(/=/,$params,2); + $v=uri_unescape($v); + if ($k ne "bind") { return $error{"add_oth"}; } + elsif ($v eq "") { return $error{"add_null_bind"}; } + elsif (my $err=add_comma_analysis($v)) { return $err; } + else { push @$value_ptr,$v;} + }#foreach + return 0; + } +} + +sub reparsequery +{ + my $query = shift(@_); + my $k; + my $v; + my $err; + if (index($query, "&") == -1) + { + ($k , $v) = split(/=/,$query,2); + $v=uri_unescape($v); + if ($k ne "keys") { return $error{"re_oth"}; } + elsif ($v eq "") { return $error{"re_null_keys"}; } + elsif ((index($v,",")==0) or (index($v,",,")!=-1) or (substr($v,-1) eq ",")) + { + return $error{"re_null_keys"}; + } + else { $_[0] = $v; return 0; } + } + else { return $error{"re_many"}; } +} + +sub get_req +{ + my $arr_ptr = shift(@_); + my $xmluri_found = 0; + my $keys_found = 0; + foreach my $el (@$arr_ptr) + { + my ($k , $v) = split(/=/,$el,2); + $v=uri_unescape($v); + if ($k eq "param") { return $error{"apply_no_dots_param"}; } + elsif ($k eq "prop") { return $error{"apply_no_dots_prop"}; } + elsif ($k eq "xmluri") + { + if ($xmluri_found) { return $error{"apply_many_uri"}; } + else + { + if ($v eq "") { return $error{"apply_null_uri"}; } + else { $_[0] = $v; $xmluri_found = 1; } + } + } + elsif ($k eq "keys") + { + if ($keys_found) { return $error{"apply_many_keys"}; } + else + { + if ($v eq "") { return $error{"apply_null_keys"}; } + elsif ((index($v,",")==0) or (index($v,",,")!=-1) or (substr($v,-1) eq ",")) + { + return $error{"apply_null_keys"}; + } + else { $_[1] = $v; $keys_found = 1; } + } + } + else { return $error{"apply_oth"}; } + }#foreach my $el (@$arr_ptr) + if ((!$xmluri_found or !$keys_found)) { return $error{"apply_few_pars"}; } + else { return 0; } +} + +sub applyparsequery +{ + my $query = shift(@_); + my $apply_keys_ptr = shift(@_); + my $keyparshoh = shift(@_); + my $proph_ptr = shift(@_); + my $applykeys; + my %prop_h; + my %genparam_h; + my %keyparam_h; + my @nodots; + + if ($query eq "") { return $error{"apply_few_pars"}; } + if (index($query, "&") == -1) { return $error{"apply_few_pars"}; } + foreach my $param (split(/&/,$query)) + { + my ($k , $v) = split(/=/,$param,2); + $v=uri_unescape($v); + if (index($k, ".") == -1) { push @nodots,$param; } + else + { + my ($l , $r) = split(/\./,$k,2); + if ($l eq "prop") + { + if (($r eq "") or ($v eq "")) { return $error{"apply_null_prop"}; } + elsif (index($r, ".") > -1) { return $error{"apply_dots_prop"}; } + else { $prop_h{$r} = $v; } + } + elsif ($l eq "param") + { + if (($r eq "") or ($v eq "")) { return $error{"apply_null_param"}; } + elsif (index($r, ".") == -1) { $genparam_h{$r} = $v; } + else + { + my ($kk , $va) = split(/\./,$r,2); + if (index($va, ".") > -1) { return $error{"apply_dots_param"}; } + elsif (($kk eq "") or ($va eq "")) { return $error{"apply_null_param"}; } + else { $keyparam_h{$kk}{$va}=$v; } + } + } + else { return $error{"apply_oth"}; } + } + } + + if (my $err = get_req(\@nodots,$_[0],$applykeys)) { return $err; } + while (my ($gn, $gv) = each %prop_h) + { + $proph_ptr->{$gn} = $gv; + } + foreach my $pkey ( keys %keyparam_h ) + { + my $k_found=0; + foreach my $verkey (split (/,/,$applykeys)) + { + if ($pkey eq $verkey) { $k_found = 1; } + } + if (! $k_found) { return $error{"apply_inv_param"}; } + } + + foreach my $applykey (split (/,/,$applykeys)) + { + while (my ($gn, $gv) = each %genparam_h) + { + $keyparshoh->{$applykey}{$gn} = $gv; + } + while (my ($kn, $kv) = each %{ $keyparam_h{$applykey} } ) + { + $keyparshoh->{$applykey}{$kn} = $kv; + } + push @$apply_keys_ptr, $applykey; + }#foreach + return 0; +} + +################################################################################################# +################################################################################################# +################################################################################################# +# Subrutines to replace values between {} on loaded templates +################################################################################################# +################################################################################################# +################################################################################################# + +sub ok_print +{ + my $message = shift(@_); + $message =~ s/(\n)/
\1/g; + my $retval = $ok_tpl; + $retval =~ s/\{MESSAGE\}/$message/g; + return $retval; +} + +sub operror_print +{ + my $message = shift(@_); + $message =~ s/(\n)/
\1/g; + my $retval = $operror_tpl; + $retval =~ s/\{ERROR\}/$message/g; + return $retval; +} + +sub synerror_print +{ + my $message = shift(@_); + my $us = shift(@_); + $message =~ s/(\n)/
\1/g; + my $retval = $synerror_tpl; + $retval =~ s/\{ERROR\}/$message/g; + $retval =~ s/\{USAGE\}/$us/g; + return $retval; +} + +################################################################################################# +################################################################################################# +################################################################################################# +# Subrutines to replace values between {} on loaded messages +################################################################################################# +################################################################################################# +################################################################################################# + +sub ok_replace +{ + my $message = shift(@_); + my $key = shift(@_); + my $s_uri = shift(@_); + $message =~ s/\{KEY\}/$key/g; + $message =~ s/\{URI\}/$s_uri/g; + return $message; +} + +sub err_replace +{ + my $message = shift(@_); + my $key = shift(@_); + my $s_uri = shift(@_); + my $errr = shift(@_); + $message =~ s/\{KEY\}/$key/g; + $message =~ s/\{URI\}/$s_uri/g; + $message =~ s/\{ERROR\}/$errr/g; + $message =~ s/\{OLDKEY\}/$errr/g; + return $message; +} + +sub parser_error_replace +{ + my $no_at = shift(@_); + $no_at =~ s/(.*)\sat\s(.*)/\1/g; + $no_at =~ s//>/g; + return $no_at; +} + +################################################################################################# +################################################################################################# +################################################################################################# +# Subrutines to load config files and templates +################################################################################################# +################################################################################################# +################################################################################################# + +sub load_messages +{ + if ($language eq "IT") + { + open(MESSAGE, "./msg/message.it") || die "Can't open config file '/msg/message.it' : $!"; + } + else + { + open(MESSAGE, "./msg/message.en") || die "Can't open config file '/msg/message.en' : $!"; + } + while(my $line = ) { + # ignore comments and full line comments + $line =~ s/#.*$//; + next unless $line =~ /\S/; + $line =~ s/\{URL\}/$puwobo_url/g; + $line =~ s/\{VER\}/$ver/g; + if ($line =~ /^(home_message)\s*=\s*(.*)$/) {$home_message = $2; } + if ($line =~ /^(help_message)\s*=\s*(.*)$/) {$help_message = $2; } + if ($line =~ /^(s_add)\s*=\s*(.*)$/) {$s_add = $2; } + if ($line =~ /^(s_reload)\s*=\s*(.*)$/) {$s_reload = $2; } + if ($line =~ /^(s_remove)\s*=\s*(.*)$/) {$s_remove = $2; } + if ($line =~ /^(list)\s*=\s*(.*)$/) {$list = $2; } + if ($line =~ /^(empty)\s*=\s*(.*)$/) {$empty = $2; } + if ($line =~ /^(all_usage)\s*=\s*(.*)$/) {$all_usage = $2; } + if ($all_usage_synerr eq "ON") + { + $help_usage=$add_usage=$remove_usage=$list_usage=$reload_usage=$apply_usage=$all_usage; + } + else + { + if ($line =~ /^(help_usage)\s*=\s*(.*)$/) {$help_usage = $2; } + if ($line =~ /^(add_usage)\s*=\s*(.*)$/) {$add_usage = $2; } + if ($line =~ /^(remove_usage)\s*=\s*(.*)$/) {$remove_usage = $2; } + if ($line =~ /^(list_usage)\s*=\s*(.*)$/) {$list_usage = $2; } + if ($line =~ /^(reload_usage)\s*=\s*(.*)$/) {$reload_usage = $2; } + if ($line =~ /^(apply_usage)\s*=\s*(.*)$/) {$apply_usage = $2; } + } + } + close MESSAGE; +} + +sub load_conf +{ + open(CONFIG, "./config") || die "Can't open config file 'config' : $!"; + while(my $line = ) { + # ignore comments and full line comments + $line =~ s/#.*$//; + next unless $line =~ /\S/; + if ($line =~ /^(working_path)\s*=\s*(.*)$/) {$working_path = $2; } + if ($line =~ /^(language)\s*=\s*(.*)$/) {$language = $2; } + if ($line =~ /^(port)\s*=\s*(.*)$/) {$port = $2; } + if ($line =~ /^(all_usage_synerr)\s*=\s*(.*)$/) {$all_usage_synerr = $2; } + if ($line =~ /^(expand_xinc)\s*=\s*(.*)$/) {$expand_xinc = $2; } + if ($line =~ /^(max_depth)\s*=\s*(.*)$/) {$max_depth = $2; } + } + close CONFIG; +} + +sub load_err +{ + if ($language eq "IT") + { + open(ERRO, "./msg/error.it") || die "Can't open config file '/msg/error.it' : $!"; + } + else + { + open(ERRO, "./msg/error.en") || die "Can't open config file '/msg/error.en' : $!"; + } + while(my $line = ) + { + # ignore comments and full line comments + $line =~ s/#.*$//; + next unless $line =~ /\S/; + if ($line =~ /^(.*?)\s*=\s*(.*)$/) {$error{$1} = $2; } + } + close ERRO; +} + +sub load_templates +{ + # load ok template + open(OK_TPL, "./tpl/ok.tpl") + || die "Can't open template file '/tpl/ok.tpl' : $!"; + while(my $line = ) {$ok_tpl .= $line; } + close OK_TPL; + + # load operror template + open(OPERROR_TPL, "./tpl/operror.tpl") + || die "Can't open template file '/tpl/operror.tpl' : $!"; + while(my $line = ) {$operror_tpl .= $line; } + close OPERROR_TPL; + + # load synerror template + open(SYNERROR_TPL, "./tpl/synerror.tpl") + || die "Can't open template file '/tpl/synerror.tpl' : $!"; + while(my $line = ) {$synerror_tpl .= $line; } + close SYNERROR_TPL; +} + +################################################################################################# +################################################################################################# +################################################################################################# +# the LibXML callbacks follow +# these callbacks are used for both the original parse AND the XInclude (if set) +################################################################################################# +################################################################################################# +################################################################################################# + +sub match_uri { + my $uri = shift; + return $uri !~ /:\/\// ? 1 : 0; # we handle only files +} + +sub open_uri { + my $uri = shift; + + my $handler = new IO::File; + if ( not $handler->open( "<$uri" ) ){ + $file = 0; + } + + return $file; +} + +sub read_uri { + my $handler = shift; + my $length = shift; + my $buffer = undef; + if ( $handler ) { + $handler->read( $rv , $length ); + } + return $buffer; +} + +sub close_uri { + my $handler = shift; + if ( $handler ) { + $handler->close(); + } + return 1; +} diff --git a/helm/hxsp/make.pl b/helm/hxsp/make.pl new file mode 100644 index 000000000..ecd3a2886 --- /dev/null +++ b/helm/hxsp/make.pl @@ -0,0 +1,17 @@ +#!/usr/bin/perl +open(MAIN, ">","./hxsp.pl")|| die "Can't open ./hxsp.pl : $!"; +my $pd = "./splitted/"; +my @pieces = ("0.init.p.pl","1.globvars.p.pl","2.start.p.pl", + "3.daemon.p.pl","4.hash.p.pl","5.libxslt.p.pl", + "6.commands.p.pl","7.qsparse.p.pl", + "8.strrep.p.pl","9.load.p.pl"); + +foreach $p (@pieces) +{ + open(P, "$pd$p") || die "Can't open $pd$p : $!"; + while(my $line =

) { print MAIN $line; } + close P; + print MAIN "\n"; +} + +close MAIN; diff --git a/helm/hxsp/msg/error.en b/helm/hxsp/msg/error.en new file mode 100644 index 000000000..9ac62ab87 --- /dev/null +++ b/helm/hxsp/msg/error.en @@ -0,0 +1,45 @@ +#syntax errors + +home_qs = syntax error: don't use parameters on hxsp if they aren't required by a specific command + +help_qs = syntax error: too parameters, help don't require any parameter + +list_qs = syntax error: too parameters, list don't require any parameter + +add_no_bind = syntax error: you must use the "bind" parameter +add_oth = syntax error: you may use only the "bind" parameter +add_null_bind = syntax error: bad bind value (NULL) +add_many_sep = syntax error: bad bind value (too commas) +add_no_sep = syntax error: bad bind value (no comma) + +re_oth = syntax error: you may use only the "keys" parameter +re_many = syntax error: you may use only the "keys" parameter and you must use it once +re_null_keys = syntax error: bad keys value (NULL) + +apply_few_pars = syntax error: xmluri and keys are both required +apply_oth = syntax error: you may use only keys, xmluri e param as parameters +apply_many_uri = syntax error: you must use the xmluri parameter once +apply_null_uri = syntax error: bad xmluri value (NULL) +apply_many_keys = syntax error: you must use the keys parameter once +apply_null_keys = syntax error: bad keys value (NULL) +apply_no_dots_param = syntax error: bad param value (no dots) +apply_no_dots_prop = syntax error: bad prop value (no dots) +apply_dots_param = syntax error: bad param value (more than 2 dots) +apply_dots_prop = syntax error: bad prop value (many dots) +apply_null_param = syntax error: bad param value (NULL) +apply_null_prop = syntax error: bad prop value (NULL) +apply_inv_param = syntax error: bad param value (key not specified in the keys parameter) + +#operative errors +add_dup_key = error in the stylesheet with key {KEY} and uri {URI}: a stylesheet with key {KEY} was already loaded use another key +add_dup_value = error in the stylesheet with key {KEY} and uri {URI}: the stylesheet with uri {URI} was already loaded with key {OLDKEY} use "reload" instead +add_xml_error = the XML parser found an error in the stylesheet with key {KEY} and uri {URI}:
{ERROR} +add_xslt_error = the XSLT parser found an error in the stylesheet with key {KEY} and uri {URI}:
{ERROR} + +re_inv_key = the stylesheet with key {KEY} was not loaded +re_no_sl = there is no stylesheets loaded + +apply_inv_key = the stylesheet with key {KEY} was not loaded +apply_xml_error = the XML parser found an error in the file {URI}:
{ERROR} +apply_xslt_error = the LibXSLT library found an error applying the stylesheet with key {KEY} and uri {URI}:
{ERROR} +apply_xslt_out_error = lthe LibXSLT library found an error creating the return file:
{ERROR} diff --git a/helm/hxsp/msg/error.it b/helm/hxsp/msg/error.it new file mode 100644 index 000000000..ebbfa8f6b --- /dev/null +++ b/helm/hxsp/msg/error.it @@ -0,0 +1,46 @@ +#sintax errors + +home_qs = errore di sintassi: non passare parametri a hxsp se non per l'utilizzo dei comandi specificati + +help_qs = errore di sintassi: troppi parametri specificati, help non richiede parametri + +list_qs = errore di sintassi: troppi parametri specificati, list non richiede parametri + +add_no_bind = errore di sintassi: si deve assegnare almeno un valore a bind +add_oth = errore di sintassi: si possono assegnare valori solo a bind +add_null_bind = errore di sintassi: valore di bind errato (NULL) +add_many_sep = errore di sintassi: valore di bind errato (troppe virgole) +add_no_sep = errore di sintassi: valore di bind errato (non seperato da virgola) + +re_oth = errore di sintassi: si possono assegnare valori solo a keys +re_many = errore di sintassi: si possono assegnare valori solo a keys e una sola volta +re_null_keys = errore di sintassi: valore di keys errato (NULL) + +apply_few_pars = errore di sintassi: richiesti almeno xmluri e keys +apply_oth = errore di sintassi: si possono assegnare valori solo a keys, xmluri e param +apply_many_uri = errore di sintassi: si può assegnare solo un valore a xmluri +apply_null_uri = errore di sintassi: valore di xmluri errato (NULL) +apply_many_keys = errore di sintassi: si possono assegnare valori a keys una sola volta +apply_null_keys = errore di sintassi: valore di keys errato (NULL) +apply_no_dots_param = errore di sintassi: valore di param errato (param richiede il punto) +apply_no_dots_prop = errore di sintassi: valore di prop errato (prop richiede il punto) +apply_dots_param = errore di sintassi: valore di param errato (param richiede al massimo 2 punti) +apply_dots_prop = errore di sintassi: valore di prop errato (prop richiede un solo punto) +apply_null_param = errore di sintassi: valore di param errato (NULL) +apply_null_prop = errore di sintassi: valore di prop errato (NULL) +apply_inv_param = errore di sintassi: valore di param errato (chiave non indicata in keys) + +#operative errors +add_dup_key = errore nello stylesheet con chiave {KEY} e uri {URI}: esiste già uno stilesheet con chiave {KEY} usare un altra chiave +add_dup_value = errore nello stylesheet con chiave {KEY} e uri {URI}: lo stylesheet con uri {URI} è già stato caricato con la chiave {OLDKEY} usare "reload" per ricaricarlo +add_xml_error = il parser xml ha rilevato un errore nello stylesheet con chiave {KEY} e uri {URI}:
{ERROR} +add_xslt_error = il parser xslt ha rilevato un errore nello stylesheet con chiave {KEY} e uri {URI}:
{ERROR} + +re_inv_key = lo stylesheet con chiave {KEY} non è stato caricato +re_no_sl = nessuno stylesheet è stato caricato + +apply_inv_key = lo stylesheet con chiave {KEY} non è stato caricato +apply_xml_error = il parser xml ha rilevato un errore nello file {URI}:
{ERROR} +apply_xslt_error = la libreria LibXSLT ha rilevato un errore applicando lo stylesheet con chiave {KEY} e uri {URI}:
{ERROR} +apply_xslt_out_error = la libreria LibXSLT ha rilevato un errore nella creazione del file in uscita:
{ERROR} + diff --git a/helm/hxsp/msg/message.en b/helm/hxsp/msg/message.en new file mode 100644 index 000000000..6a43e828b --- /dev/null +++ b/helm/hxsp/msg/message.en @@ -0,0 +1,96 @@ +######################################################################## +######################################################################## +# +# Interface messages config file in EN language for hxsp +# Author: Alessandro Barzanti (barzu@libero.it) +# +######################################################################## +######################################################################## + +######################################################################## +######################################################################## +# usage messages +######################################################################## +######################################################################## + +######################################################################## +# Message sent after help syntax errors if "all_usage_synerr" is set OFF +######################################################################## +help_usage = usage:
{URL}/help + +######################################################################## +# Message sent after add syntax errors if "all_usage_synerr" is set OFF +######################################################################## +add_usage = usage:
{URL}/add?bind=key,stylesheet[&bind=key,stylesheet]* + +######################################################################## +# Message sent after remove syntax errors if "all_usage_synerr" is set OFF +######################################################################## +remove_usage = usage:
{URL}/remove[?keys=key_1,...,key_n] + +######################################################################## +# Message sent after list syntax errors if "all_usage_synerr" is set OFF +######################################################################## +list_usage = usage:
{URL}/list + +######################################################################## +# Message sent after reload syntax errors if "all_usage_synerr" is set OFF +######################################################################## +reload_usage =usage:
{URL}/reload[?keys=key_1,...,key_n] + +######################################################################## +# Message sent after apply syntax errors if "all_usage_synerr" is set OFF +######################################################################## +apply_usage =usage:
{URL}/apply?xmluri=xmldata&keys=key_1,...,key_n[¶m.name=value]*[¶m.key.name=value]*[&prop.name=[value]]* + +######################################################################## +# Message sent after "home_message" when hxsp was called without commands +# and sent after "help_message" when hxsp was called with the help command +# and after all syntax errors if "all_usage_synerr" is set ON +######################################################################## +all_usage = usage:

  • {URL}/help
  • {URL}/add?bind=key,stylesheet&bind=key,stylesheet]*
  • {URL}/remove[?keys=key_1,...,key_n]
  • {URL}/list
  • {URL}/reload[?keys=key_1,...,key_n]
  • {URL}/apply?xmluri=xmldata&keys=key_1,...,key_n[¶m.name=value]*[¶m.key.name=value]*[&prop.name=[value]]*
+ +######################################################################## +######################################################################## +#operative messages +######################################################################## +######################################################################## + +######################################################################## +# Message sent when hxsp was called without commands +######################################################################## +home_message =

hxsp v{VER} active


+ +######################################################################## +# Message sent when hxsp was called with the help command +######################################################################## +help_message = + +######################################################################## +# Message sent when a stylesheet is added +######################################################################## +s_add = the stylesheet with key: {KEY} and uri: {URI} was successfully loaded + +######################################################################## +# Message sent when a stylesheet is reloaded +######################################################################## +s_reload = the stylesheet with key: {KEY} and uri: {URI} was successfully reloaded + +######################################################################## +# Message sent when a stylesheet is removed +######################################################################## +s_remove = the stylesheet with key: {KEY} and uri: {URI} was successfully removed + +######################################################################## +# Message to print the stylesheet status for list command +######################################################################## +list = the stylesheet with key: {KEY} and uri: {URI} was loaded + +######################################################################## +# Message sent when the list command was called +# and there is no stylesheet loaded +######################################################################## +empty = there is no stylesheet loaded + +######################################################################## +######################################################################## diff --git a/helm/hxsp/msg/message.it b/helm/hxsp/msg/message.it new file mode 100644 index 000000000..77c1d6b79 --- /dev/null +++ b/helm/hxsp/msg/message.it @@ -0,0 +1,96 @@ +######################################################################## +######################################################################## +# +# Interface messages config file in IT language for hxsp +# Author: Alessandro Barzanti (barzu@libero.it) +# +######################################################################## +######################################################################## + +######################################################################## +######################################################################## +# usage messages +######################################################################## +######################################################################## + +######################################################################## +# Message sent after help syntax errors if "all_usage_synerr" is set OFF +######################################################################## +help_usage = utilizzo:
{URL}/help + +######################################################################## +# Message sent after add syntax errors if "all_usage_synerr" is set OFF +######################################################################## +add_usage = utilizzo:
{URL}/add?bind=key,stylesheet[&bind=key,stylesheet]* + +######################################################################## +# Message sent after remove syntax errors if "all_usage_synerr" is set OFF +######################################################################## +remove_usage = utilizzo:
{URL}/remove[?keys=key_1,...,key_n] + +######################################################################## +# Message sent after list syntax errors if "all_usage_synerr" is set OFF +######################################################################## +list_usage = utilizzo:
{URL}/list + +######################################################################## +# Message sent after reload syntax errors if "all_usage_synerr" is set OFF +######################################################################## +reload_usage = utilizzo:
{URL}/reload[?keys=key_1,...,key_n] + +######################################################################## +# Message sent after apply syntax errors if "all_usage_synerr" is set OFF +######################################################################## +apply_usage = utilizzo:
{URL}/apply?xmluri=xmldata&keys=key_1,...,key_n[¶m.name=value]*[¶m.key.name=value]*[&prop.name=[value]]* + +######################################################################## +# Message sent after "home_message" when hxsp was called without commands +# and sent after "help_message" when hxsp was called with the help command +# and after all syntax errors if "all_usage_synerr" is set ON +######################################################################## +all_usage = utilizzo:
  • {URL}/help
  • {URL}/add?bind=key,stylesheet&bind=key,stylesheet]*
  • {URL}/remove[?keys=key_1,...,key_n]
  • {URL}/list
  • {URL}/reload[?keys=key_1,...,key_n]
  • {URL}/apply?xmluri=xmldata&keys=key_1,...,key_n[¶m.name=value]*[¶m.key.name=value]*[&prop.name=[value]]*
+ +######################################################################## +######################################################################## +#operative messages +######################################################################## +######################################################################## + +######################################################################## +# Message sent when hxsp was called without commands +######################################################################## +home_message =

hxsp v{VER} attivo


+ +######################################################################## +# Message sent when hxsp was called with the help command +######################################################################## +help_message =

hxsp v{VER} attivo


+ +######################################################################## +# Message sent when a stylesheet is added +######################################################################## +s_add = lo stylesheet con chiave: {KEY} e uri: {URI} è stato caricato con successo + +######################################################################## +# Message sent when a stylesheet is reloaded +######################################################################## +s_reload = lo stylesheet con chiave: {KEY} e uri: {URI} è stato ricaricato con successo + +######################################################################## +# Message sent when a stylesheet is removed +######################################################################## +s_remove = lo stylesheet con chiave: {KEY} e uri: {URI} è stato rimosso + +######################################################################## +# Message to print the stylesheet status for list command +######################################################################## +list = lo stylesheet con chiave: {KEY} e uri: {URI} è presente nel sistema + +######################################################################## +# Message sent when the list command was called +# and there is no stylesheet loaded +######################################################################## +empty = non è ancora stato caricato nessuno stylesheet + +######################################################################## +######################################################################## diff --git a/helm/hxsp/splitted/0.init.p.pl b/helm/hxsp/splitted/0.init.p.pl new file mode 100644 index 000000000..6c378c716 --- /dev/null +++ b/helm/hxsp/splitted/0.init.p.pl @@ -0,0 +1,30 @@ +#!/usr/bin/perl + +################################################################################################# +################################################################################################# +################################################################################################# +# +# H.X.S.P. V 1.0 +# T S T R +# T L Y O +# P T E C +# S E +# H S +# E S +# E O +# T R +# +################################################################################################# +################################################################################################# +################################################################################################# + +use HTTP::Daemon; +use HTTP::Status; +use HTTP::Request; +use LWP::UserAgent; +use URI::Escape; +use CGI; +use FindBin; +use XML::LibXML; +use XML::LibXSLT; +use IO; diff --git a/helm/hxsp/splitted/1.globvars.p.pl b/helm/hxsp/splitted/1.globvars.p.pl new file mode 100644 index 000000000..9a9a88708 --- /dev/null +++ b/helm/hxsp/splitted/1.globvars.p.pl @@ -0,0 +1,95 @@ +################################################################################################# +################################################################################################# +################################################################################################# +# Global Variables +################################################################################################# +################################################################################################# +################################################################################################# + +# Version number +my $ver ="1.0"; + +# Working path of hxsp (loaded from config) +my $working_path; + +# Interface language (loaded from config) +my $language; + +# Port to use for hxsp (loaded from config) +my $port; + +# Use complete command description on syntax error if ON (loaded from config) +my $all_usage_synerr; + +# Include XIncludes on the fly if ON (loaded from config) +my $expand_xinc; + +# Max Depth of the DOM tree while parsing +my $max_depth; + +# Message sent when hxsp was called without commands (loaded from message.##) +my $home_message; + +# Message sent when hxsp was called with the help command (loaded from message.##) +my $help_message; + +# Message sent when a stylesheet is added (loaded from message.##) +my $s_add; + +# Message sent when a stylesheet is reloaded (loaded from message.##) +my $s_reload; + +# Message sent when a stylesheet is removed (loaded from message.##) +my $s_remove; + +# Message to print the stylesheet status for list command (loaded from message.##) +my $list; + +# Message sent when the list command was called +# and there is no stylesheet loaded (loaded from message.##) +my $empty; + +# Message sent after "home_message" when hxsp was called without commands +# and sent after "help_message" when hxsp was called with the help command +# and after all syntax errors if "all_usage_synerr" is set ON (loaded from message.##) +my $all_usage; + +# All the following syntax errors messages are used #only# if "all_usage_synerr" is set OFF + +# Message sent on help syntax errors (loaded from message.##) +my $help_usage; + +# Message sent on add syntax errors (loaded from message.##) +my $add_usage; + +# Message sent on remove syntax errors (loaded from message.##) +my $remove_usage; + +# Message sent on list syntax errors (loaded from message.##) +my $list_usage; + +# Message sent on reload syntax errors (loaded from message.##) +my $reload_usage; + +# Message sent on apply syntax errors (loaded from message.##) +my $apply_usage; + +# The error hash contains the error messages to call in case of syntax +# or operative errors, the keys are defined by the left value of each line in error## +my %error; + +# load ok template +my $ok_tpl; + +# load operror template +my $operror_tpl; + +# load synerror template +my $synerror_tpl; + +# This is the data structure to store the loaded stylesheets (hash of array) +# [0] :Styleseet URI , [1] : Loaded styleseet +my %stylesheet_hash; + +# This is a hash for fast duplicate uri detection +my %by_name; diff --git a/helm/hxsp/splitted/2.start.p.pl b/helm/hxsp/splitted/2.start.p.pl new file mode 100644 index 000000000..a123ca798 --- /dev/null +++ b/helm/hxsp/splitted/2.start.p.pl @@ -0,0 +1,49 @@ +################################################################################################# +################################################################################################# +################################################################################################# +# Starting Operations +################################################################################################# +################################################################################################# +################################################################################################# + +# chdir to the directory of this perl script +chdir $FindBin::Bin; + +# load CONFIG +load_conf(); + +# initialize the objects to use LibXML and LibXSLT +my $parser = XML::LibXML->new(); +my $xslt = XML::LibXSLT->new(); + +# initialize the LibXML callbacks to load uri's +XML::LibXML->callbacks(\&match_uri,\&open_uri,\&read_uri,\&close_uri); + +# include XIncludes on the fly if required +if ($expand_xinc eq "ON") { $parser->expand_xinclude( 1 ); } + +# initialize the hxsp as HTTP::Daemon +my $d = new HTTP::Daemon LocalPort => $port; + +# get the complete working url of hxsp +my $puwobo_url = $d->url().$working_path; + +# set the working path to be comparable with url->path +$working_path = "/". $working_path; + +# load messages +load_messages(); + +# load error +load_err(); + +# load templates +load_templates(); + +# print starting information on console +print qq{ +hxsp v$ver active at: + Language is $language + On syntax error usage of every command is $all_usage_synerr + Include XIncludes on the fly is $expand_xinc; +}; diff --git a/helm/hxsp/splitted/3.daemon.p.pl b/helm/hxsp/splitted/3.daemon.p.pl new file mode 100644 index 000000000..3e3787336 --- /dev/null +++ b/helm/hxsp/splitted/3.daemon.p.pl @@ -0,0 +1,131 @@ +################################################################################################# +################################################################################################# +# HTTP::Daemon Operations +################################################################################################# +################################################################################################# + +# do not accumulate defunct processes +$SIG{CHLD} = "IGNORE"; +$SIG{USR1} = \&listen; # sent by the child to make the parent read the pipe + +pipe LIST_CHILD, TELL_PARENT; +pipe LIST_PARENT, TELL_CHILD; +TELL_PARENT->autoflush(1); +TELL_CHILD->autoflush(1); + + +sub listen { + my $res; + my $query = ; + if ($query =~ /^add /) { + $query =~ s/^add //; + chomp($query); + $res = add($query); + } + elsif ($query =~ /^reload /) { + $query =~ s/^reload //; + chomp($query); + $res = reload($query); + } + elsif ($query =~ /^remove /) { + $query =~ s/^remove //; + chomp($query); + $res = remove($query); + } + print TELL_CHILD "$res\n"; + print TELL_CHILD "____\n"; # end of response +} + +while (my $c = $d->accept) #connect +{ + if (fork() == 0) #start new concurrent process + { + while (my $r = $c->get_request) #get http request + { + if ($r->method eq 'GET' && + ($r->url->path eq $working_path or $r->url->path eq $working_path."/"))#start dir + { + my $response = new HTTP::Response; + $response->header('Cache-Control' => 'no-cache','Pragma' => "no-cache",'Expires' => '0'); + $response->content(home($r->url->query)); + $c->send_response($response); + } + elsif ($r->method eq 'GET' && $r->url->path eq $working_path."/help")#usage + { + my $response = new HTTP::Response; + $response->header('Cache-Control' => 'no-cache','Pragma' => "no-cache",'Expires' => '0'); + $response->content(help($r->url->query)); + $c->send_response($response); + } + elsif ($r->method eq 'GET' && $r->url->path eq $working_path."/add")#add + { + my $response = new HTTP::Response; + kill(USR1,getppid()); # ask the parent to read the pipe + my $qs = $r->url->query; + print TELL_PARENT "add $qs\n"; + my $in; + while (($in = ) ne "____\n") { + $res .= $in; + } + chomp($res); + $response->header('Cache-Control' => 'no-cache','Pragma' => "no-cache",'Expires' => '0'); + $response->content($res); + $c->send_response($response); + } + elsif ($r->method eq 'GET' && $r->url->path eq $working_path."/remove")#remove + { + my $response = new HTTP::Response; + kill(USR1,getppid()); # ask the parent to read the pipe + my $qs = $r->url->query; + print TELL_PARENT "remove $qs\n"; + my $in; + my $res=""; + while (($in = ) ne "____\n") { + $res .= $in; + } + chomp($res); + $response->content($res); + $response->header('Cache-Control' => 'no-cache','Pragma' => "no-cache",'Expires' => '0'); + $c->send_response($response); + } + elsif ($r->method eq 'GET' && $r->url->path eq $working_path."/reload")#reload + { + my $response = new HTTP::Response; + kill(USR1,getppid()); # ask the parent to read the pipe + my $qs = $r->url->query; + print TELL_PARENT "reload $qs\n"; + my $in; + my $res=""; + while (($in = ) ne "____\n") { + $res .= $in; + } + chomp($res); + $response->content($res); + $response->header('Cache-Control' => 'no-cache','Pragma' => "no-cache",'Expires' => '0'); + $c->send_response($response); + } + elsif ($r->method eq 'GET' && $r->url->path eq $working_path."/list")#list + { + my $response = new HTTP::Response; + $response->header('Cache-Control' => 'no-cache','Pragma' => "no-cache",'Expires' => '0'); + $response->content(list($r->url->query)); + $c->send_response($response); + } + elsif ($r->method eq 'GET' && $r->url->path eq $working_path."/apply")#apply + { + my %headers; + my $response = new HTTP::Response; + $response->content(apply($r->url->query,\%headers)); + $response->header(%headers); + $c->send_response($response); + } + else #wrong command or not working_path + { + $c->send_error(RC_FORBIDDEN) + } + } + $c->close; + undef($c); + exit; + } # fork +} diff --git a/helm/hxsp/splitted/4.hash.p.pl b/helm/hxsp/splitted/4.hash.p.pl new file mode 100644 index 000000000..e3b1fc140 --- /dev/null +++ b/helm/hxsp/splitted/4.hash.p.pl @@ -0,0 +1,150 @@ +################################################################################################# +################################################################################################# +################################################################################################# +# Stylesheet hash check subrutines +################################################################################################# +################################################################################################# +################################################################################################# + +################################################################################################# +# sub addcheckvalues +# Usage: addcheckvalues($key,$uri); +# Returns: error message or 0 if no errors found +# Do: check if key and uri are already loaded +# Used by: addvalues +# Uses : err_replace +################################################################################################# +sub addcheckvalues +{ + my $ac_key = shift(@_); + my $ac_uri = shift(@_); + if (exists $stylesheet_hash{$ac_key}) + { + return err_replace($error{"add_dup_key"},$ac_key,$ac_uri,""); + } + elsif (exists $by_name{$ac_uri}) + { + return err_replace($error{"add_dup_value"},$ac_key,$ac_uri,$by_name{$ac_key}); + } + else { return 0; } +} +################################################################################################# + +################################################################################################# +# sub recheckvalues +# Usage: recheckvalues($key); +# Returns: error message or 0 if no errors found +# Do: check if key are loaded +# Used by: remove, reloadvalues +# Uses : err_replace +################################################################################################# +sub recheckvalues +{ + my $re_key = shift(@_); + if (not exists $stylesheet_hash{$re_key}) + { + return err_replace($error{"re_inv_key"},$re_key,"",""); + } + else { return 0; } +} +################################################################################################# + +################################################################################################# +# sub applycheckvalues +# Usage: applycheckvalues(\@keys); +# Returns: error message or 0 if no errors found +# Do: check if keys in @keys are loaded +# Used by: remove, reloadvalues +# Uses : err_replace +################################################################################################# +sub applycheckvalues +{ + my $applykeys_ptr = shift(@_); + foreach $applykey (@$applykeys_ptr) + { + if (not exists $stylesheet_hash{$applykey}) + { + return err_replace($error{"apply_inv_key"},$applykey,"",""); + } + } + return 0; +} +################################################################################################# + +################################################################################################# +################################################################################################# +################################################################################################# +# Stylesheet hash modify subrutines +################################################################################################# +################################################################################################# +################################################################################################# + +################################################################################################# +# sub addvalues +# Usage: if add_halt_on_errors is ON addvalues($key,$uri,@added); +# else addvalues($key,$uri) +# Returns: error message or 0 on success, +# if add_halt_on_errors is ON return all the added keys on @added +# Do: add the values to the stylesheet hash +# Used by: add +# Uses : addcheckvalues, loadstyle +################################################################################################# +sub addvalues +{ + my $av_key = shift(@_); + my $av_uri = shift(@_); + my $av_stylesheet; #parsed stylesheet to be placed in hash + if (my $err = addcheckvalues($av_key,$av_uri)) { return $err; } + elsif (my $err = loadstyle($av_key, $av_uri, $av_stylesheet)) { return $err; } + else + { + $stylesheet_hash{$av_key}[0]=$av_uri; + $stylesheet_hash{$av_key}[1]=$av_stylesheet; + $by_name{$av_uri}=$av_key; + return 0; + } +} +################################################################################################# + +################################################################################################# +# sub removevalues +# Usage: removevalues($key); +# Returns: message +# Do: remove the key specified and relative values from the stylesheet hash +# Used by: remove, do_remove +# Uses : ok_replace +################################################################################################# +sub removevalues +{ + my $cr_key = shift(@_); + my $cr_uri = $stylesheet_hash{$cr_key}[0]; + delete $stylesheet_hash{$cr_key}; + delete $by_name{$cr_uri}; + return ok_replace("$s_remove\n",$cr_key,$cr_uri); +} +################################################################################################# + +################################################################################################# +# sub reloadvalues +# Usage: if add_halt_on_errors is ON reloadvalues($key.\%reloaded); +# else reloadvalues($key); +# Returns: error message or 0 on success, +# if add_halt_on_errors is ON return the old stylesheets in %reloaded +# Do: reload the stlylesheet with the key specified +# Used by: do_reload +# Uses : recheckvalues, loadstyle +################################################################################################# +sub reloadvalues +{ + my $rv_key = shift(@_); + my $rv_uri = $stylesheet_hash{$rv_key}[0]; + my $rv_stylesheet; #parsed stylesheet to be placed in hash + if (my $err = recheckvalues($rv_key)) { return $err; } + elsif (my $err = loadstyle($rv_key, $rv_uri, $rv_stylesheet)) { return $err; } + else + { + $stylesheet_hash{$rv_key}[1] = $rv_stylesheet; + return 0; + } +} +################################################################################################# diff --git a/helm/hxsp/splitted/5.libxslt.p.pl b/helm/hxsp/splitted/5.libxslt.p.pl new file mode 100644 index 000000000..4d90dc1fb --- /dev/null +++ b/helm/hxsp/splitted/5.libxslt.p.pl @@ -0,0 +1,174 @@ +################################################################################################# +################################################################################################# +################################################################################################# +# LibXML LIBXSLT access subrutines +################################################################################################# +################################################################################################# +################################################################################################# + +################################################################################################# +# sub loadstyle +# Usage: loadstyle($key,$uri,$stylesheet); +# Returns: error message or 0 on success, +# parsed stylesheet in $stylesheet +# Do: parse the stylesheet at the given uri +# Used by: addvalues , reloadvalues +# Uses : err_replace, parser_error_replace +################################################################################################# +sub loadstyle +{ + my $ls_key= shift(@_); + my $ls_uri= shift(@_); + my $uncatched = ""; + my $line = ""; + my $style_doc; + pipe P, STDERR; + STDERR->autoflush(1); + eval { $style_doc = $parser->parse_file($ls_uri); }; + print STDERR "____\n"; + while(($line =

) ne "____\n") { $uncatched .= $line; } + close P; + + if ($@ or $uncatched ne "") + { + return err_replace($error{"add_xml_error"},$ls_key,$ls_uri,parser_error_replace($@.$uncatched)); + } + else + { + pipe P, STDERR; + STDERR->autoflush(1); + $uncatched = ""; + $line = ""; + eval { $_[0] = $xslt->parse_stylesheet($style_doc); }; + print STDERR "____\n"; + while(($line =

) ne "____\n") { $uncatched .= $line; } + close P; + if ($@ or $uncatched ne "") + { + return err_replace($error{"add_xslt_error"},$ls_key,$ls_uri,parser_error_replace($@.$uncatched)); + } + else {return 0} + } +} + +sub load_xml_doc +{ + my $xmluri = shift(@_); + my $uncatched = ""; + my $line = ""; + pipe P, STDERR; + STDERR->autoflush(1); + eval { $_[0] = $parser->parse_file($xmluri); }; + print STDERR "____\n"; + while(($line =

) ne "____\n") { $uncatched .= $line; } + close P; + if ($@ or $uncatched ne "") + { + return err_replace($error{"apply_xml_error"},"",$xmluri,parser_error_replace($@.$uncatched)); + } + else {return 0} +} + +sub apply_style +{ + my $k = shift(@_); + my $params_ptr = shift(@_); + my %params = XML::LibXSLT::xpath_to_string(%$params_ptr); + my $pippo; + my $uncatched = ""; + my $line = ""; + pipe P, STDERR; + STDERR->autoflush(1); + XML::LibXSLT->max_depth($max_depth); + eval { $_[0] = $stylesheet_hash{$k}[1]->transform($_[0],%params); }; + print STDERR "____\n"; + while(($line =

) ne "____\n") { $uncatched .= $line; } + close P; + if ($@ or $uncatched ne "") + { + my $e_r = parser_error_replace($@.$uncatched); + return err_replace($error{"apply_xslt_error"},$k,$stylesheet_hash{$k}[0],$e_r); + } + else {return 0} +} +sub get_results +{ + my $k = shift(@_); + my $results = shift(@_); + my $retval; + my $uncatched = ""; + my $line = ""; + pipe P, STDERR; + STDERR->autoflush(1); + eval { $retval = $stylesheet_hash{$k}[1]->output_string($results); }; + print STDERR "____\n"; + while(($line =

) ne "____\n") { $uncatched .= $line; } + close P; + if ($@ or $uncatched ne "") + { + my $e_r = parser_error_replace($@.$uncatched); + return operror_print(err_replace($error{"apply_xslt_out_error"},"","",$e_r)); + } + else { return $retval; } +} +sub get_results_prop +{ + my $result = shift(@_); + my $retval; + my $uncatched = ""; + my $line = ""; + pipe P, STDERR; + STDERR->autoflush(1); + eval { $retval = $result->toString; }; + print STDERR "____\n"; + while(($line =

) ne "____\n") { $uncatched .= $line; } + close P; + if ($@ or $uncatched ne "") + { + my $e_r = parser_error_replace($@.$uncatched); + return operror_print(err_replace($error{"apply_xslt_out_error"},"","",$e_r)); + } + else { return $retval; } +} + +sub get_results_html +{ + my $result = shift(@_); + my $retval; + my $uncatched = ""; + my $line = ""; + pipe P, STDERR; + STDERR->autoflush(1); + eval { $retval = $result->toStringHTML();}; + print STDERR "____\n"; + while(($line =

) ne "____\n") { $uncatched .= $line; } + close P; + if ($@ or $uncatched ne "") + { + my $e_r = parser_error_replace($@.$uncatched); + return operror_print(err_replace($error{"apply_xslt_out_error"},"","",$e_r)); + } + else { return $retval; } +} + +sub decode +{ + my $result = shift(@_); + my $enc = shift(@_); + my $retval; + my $uncatched = ""; + my $line = ""; + pipe P, STDERR; + STDERR->autoflush(1); + eval { $retval = decodeFromUTF8($enc, $result);}; + print STDERR "____\n"; + while(($line =

) ne "____\n") { $uncatched .= $line; } + close P; + if ($@ or $uncatched ne "") + { + my $e_r = parser_error_replace($@.$uncatched); + return operror_print(err_replace($error{"apply_xslt_out_error"},"","",$e_r)); + } + else { return $retval; } +} +################################################################################################# diff --git a/helm/hxsp/splitted/6.commands.p.pl b/helm/hxsp/splitted/6.commands.p.pl new file mode 100644 index 000000000..142acc590 --- /dev/null +++ b/helm/hxsp/splitted/6.commands.p.pl @@ -0,0 +1,215 @@ +################################################################################################# +################################################################################################# +################################################################################################# +# Commands subrutines +################################################################################################# +################################################################################################# +################################################################################################# + +################################################################################################# +# sub add +# Usage: add($http_query); +# Returns: values for HTTP::Response +# Do: add stylesheet(s) to hash +# Used by: daemon +# Uses : addparsequery, addvalues, ok_replace, +# ok_print, synerror_print, operror_print +################################################################################################# +sub add +{ + my $http_query = shift(@_); # querystring + my $cont =""; # return value + my @binds; #values of binds passed via querystring + my $err; # error string + if ($err = addparsequery($http_query,\@binds)) { return synerror_print($err,$add_usage); } + else + { + foreach my $bind (@binds) + { + my ($a_key , $e_uri) = split(/,/,$bind,2); + my $une_uri = uri_unescape($e_uri); + if ($err = addvalues($a_key,$une_uri)) { $cont .= "$err\n"; } + else { $cont .= ok_replace("$s_add\n",$a_key,$une_uri); } + }#foreach + return ok_print($cont); + } +} +################################################################################################# + +################################################################################################# +# sub remove +# Usage: remove($http_query); +# Returns: values for HTTP::Response +# Do: remove stylesheet(s) from hash +# Used by: daemon +# Uses : reparsequery, getkeys, recheckvalues, removevalues, +# ok_print, synerror_print, operror_print +################################################################################################# +sub remove +{ + my $http_query = shift(@_); # querystring + my $rem_keys; + my $cont=""; + my $err; + if ($http_query eq "") + { + my $i=0; + foreach my $rem_key (keys %stylesheet_hash) + { + $cont .= removevalues($rem_key); + $i++; + } + if ($i==0) { return operror_print($error{"re_no_sl"}); } + } + elsif ($err = reparsequery($http_query,$rem_keys)){return synerror_print($err,$remove_usage);} + else + { + foreach my $rem_key (split (/,/,$rem_keys)) + { + if (my $err = recheckvalues($rem_key)) { $cont .= "$err\n"; } + else { $cont .= removevalues($rem_key); } + } + } + return ok_print($cont); +} +################################################################################################# + +################################################################################################# +# sub reload +# Usage: remove($http_query); +# Returns: values for HTTP::Response +# Do: remove stylesheet(s) from hash +# Used by: daemon +# Uses : reparsequery, getkeys, recheckvalues, removevalues, +# ok_print, synerror_print, operror_print +################################################################################################# +sub reload #reload stylesheet(s) from hash +{ + my $http_query = shift(@_); + my $rel_keys; + my @rel_k; + my $dr_cont = ""; + if ($http_query eq "") + { + my $i=0; + foreach my $key (keys %stylesheet_hash) + { + if (my $err = reloadvalues($key)) { return $dr_cont .= $err; } + else {$dr_cont .= ok_replace("$s_reload\n",$key,$stylesheet_hash{$key}[0]);} + $i++; + } + if ($i==0) { return operror_print($error{"re_no_sl"}); } + } + elsif ($err = reparsequery($http_query,$rel_keys)){return synerror_print($err,$reload_usage);} + else + { + foreach my $key (split (/,/,$rel_keys)) + { + if (my $err = reloadvalues($key)) { return $dr_cont .= $err; } + else {$dr_cont .= ok_replace("$s_reload\n",$key,$stylesheet_hash{$key}[0]);} + } + } + return ok_print($dr_cont); +} +################################################################################################# + +sub apply #apply stylesheets +{ + my $http_query = shift(@_); + my $headers_ptr = shift(@_); + my $xmluri; + my @applykeys; + my %app_param; + my %app_prop; + my $results; + my $lastkey; + my $enc; + + if (my $err=applyparsequery($http_query,\@applykeys,\%app_param,\%app_prop,$xmluri)) + { + return synerror_print($err,$apply_usage); + } + elsif (my $err=applycheckvalues(\@applykeys)) { return operror_print($err); } + elsif (my $err=load_xml_doc($xmluri,$results)) { return operror_print($err); } + #apply + foreach my $applykey (@applykeys) + { + $lastkey=$applykey; + if (my $err=apply_style($applykey,\%{$app_param{$applykey}},$results)) + { + return operror_print($err); + } + }#foreach + my $i=0; + while (my ($n, $v) = each %app_prop) + { + if (($n eq "method") or ($n eq "METHOD")) + { + if ($v eq 'html') { $headers_ptr->{'Content-Type'}='text/html'; } + elsif ($v eq 'text') { $headers_ptr->{'Content-Type'}='text/plain'; } + else { $headers_ptr->{'Content-Type'}='text/xml'; } + } + if (($n eq "encoding") or ($n eq "ENCODING")) + { + $headers_ptr->{'Content-Encoding'}=$v; + if ($v ne "UTF-8") { $enc = $v; } + } + if (($n eq "media-type") or ($n eq "MEDIA_TYPE") or ($n eq "MEDIA-TYPE")) + { + $headers_ptr->{'Content-Type'}=$v; + } + $i++; + } + if ($i == 0) + { + %$headers_ptr= ('Cache-Control' => 'no-cache','Pragma' => "no-cache",'Expires' => '0'); + return get_results($lastkey,$results); + } + else + { + my $result; + $headers_ptr->{'Cache-Control'} = 'no-cache'; + $headers_ptr->{'Pragma'} = "no-cache"; + $headers_ptr->{'Expires'} = '0'; + if ($headers_ptr->{'Content-Type'} eq 'text/html') + { + $result = get_results_html($results); + } + else + { + $result = get_results_prop($results); + if ($enc) + { + $result = decode($result,$enc); + } + } + return $result; + } +} + +sub list #list all the stylesheet loaded +{ + my $cont=""; + my $ind = 0; + foreach $key (keys %stylesheet_hash) + { + $cont .= ok_replace("$list\n",$key,$stylesheet_hash{$key}[0]); + $ind++; + } + if ($ind > 0) { return ok_print($cont); } + else { return ok_print($empty); } +} + +sub home #return Dispay active +{ + if ($_[0] ne "") { return synerror_print($error{"home_qs"},$all_usage); } + else { + return ok_print($home_message.$all_usage); + } +} + +sub help #return html help +{ + if ($_[0] ne "") { return synerror_print($error{"help_qs"},$help_usage); } + return ok_print($help_message.$all_usage); +} diff --git a/helm/hxsp/splitted/7.qsparse.p.pl b/helm/hxsp/splitted/7.qsparse.p.pl new file mode 100644 index 000000000..aa7be53b5 --- /dev/null +++ b/helm/hxsp/splitted/7.qsparse.p.pl @@ -0,0 +1,172 @@ +################################################################################################# +################################################################################################# +# Subrutines to get parameters for commands from Query String (query string parsing) +################################################################################################# +################################################################################################# + +sub add_comma_analysis +{ + my $bind = shift(@_); + my ($l , $r) = split(/,/,$bind,2); + if (index($bind ,",") == -1) { return $error{"add_no_sep"}; } + elsif (index($r ,",") != -1) { return $error{"add_many_sep"}; } + elsif (($l eq "") or ($r eq "")) { return $error{"add_null_bind"}; } + else { return 0; } +} +## +#usage: +#addparsequery($querystring,\@binds) +#returns $errcode; +sub addparsequery +{ + my $query = shift(@_); + my $value_ptr = shift(@_); + if ($query eq "") { return $error{"add_no_bind"}; } + else + { + foreach my $params (split(/&/,$query)) + { + my ($k , $v) = split(/=/,$params,2); + $v=uri_unescape($v); + if ($k ne "bind") { return $error{"add_oth"}; } + elsif ($v eq "") { return $error{"add_null_bind"}; } + elsif (my $err=add_comma_analysis($v)) { return $err; } + else { push @$value_ptr,$v;} + }#foreach + return 0; + } +} + +sub reparsequery +{ + my $query = shift(@_); + my $k; + my $v; + my $err; + if (index($query, "&") == -1) + { + ($k , $v) = split(/=/,$query,2); + $v=uri_unescape($v); + if ($k ne "keys") { return $error{"re_oth"}; } + elsif ($v eq "") { return $error{"re_null_keys"}; } + elsif ((index($v,",")==0) or (index($v,",,")!=-1) or (substr($v,-1) eq ",")) + { + return $error{"re_null_keys"}; + } + else { $_[0] = $v; return 0; } + } + else { return $error{"re_many"}; } +} + +sub get_req +{ + my $arr_ptr = shift(@_); + my $xmluri_found = 0; + my $keys_found = 0; + foreach my $el (@$arr_ptr) + { + my ($k , $v) = split(/=/,$el,2); + $v=uri_unescape($v); + if ($k eq "param") { return $error{"apply_no_dots_param"}; } + elsif ($k eq "prop") { return $error{"apply_no_dots_prop"}; } + elsif ($k eq "xmluri") + { + if ($xmluri_found) { return $error{"apply_many_uri"}; } + else + { + if ($v eq "") { return $error{"apply_null_uri"}; } + else { $_[0] = $v; $xmluri_found = 1; } + } + } + elsif ($k eq "keys") + { + if ($keys_found) { return $error{"apply_many_keys"}; } + else + { + if ($v eq "") { return $error{"apply_null_keys"}; } + elsif ((index($v,",")==0) or (index($v,",,")!=-1) or (substr($v,-1) eq ",")) + { + return $error{"apply_null_keys"}; + } + else { $_[1] = $v; $keys_found = 1; } + } + } + else { return $error{"apply_oth"}; } + }#foreach my $el (@$arr_ptr) + if ((!$xmluri_found or !$keys_found)) { return $error{"apply_few_pars"}; } + else { return 0; } +} + +sub applyparsequery +{ + my $query = shift(@_); + my $apply_keys_ptr = shift(@_); + my $keyparshoh = shift(@_); + my $proph_ptr = shift(@_); + my $applykeys; + my %prop_h; + my %genparam_h; + my %keyparam_h; + my @nodots; + + if ($query eq "") { return $error{"apply_few_pars"}; } + if (index($query, "&") == -1) { return $error{"apply_few_pars"}; } + foreach my $param (split(/&/,$query)) + { + my ($k , $v) = split(/=/,$param,2); + $v=uri_unescape($v); + if (index($k, ".") == -1) { push @nodots,$param; } + else + { + my ($l , $r) = split(/\./,$k,2); + if ($l eq "prop") + { + if (($r eq "") or ($v eq "")) { return $error{"apply_null_prop"}; } + elsif (index($r, ".") > -1) { return $error{"apply_dots_prop"}; } + else { $prop_h{$r} = $v; } + } + elsif ($l eq "param") + { + if (($r eq "") or ($v eq "")) { return $error{"apply_null_param"}; } + elsif (index($r, ".") == -1) { $genparam_h{$r} = $v; } + else + { + my ($kk , $va) = split(/\./,$r,2); + if (index($va, ".") > -1) { return $error{"apply_dots_param"}; } + elsif (($kk eq "") or ($va eq "")) { return $error{"apply_null_param"}; } + else { $keyparam_h{$kk}{$va}=$v; } + } + } + else { return $error{"apply_oth"}; } + } + } + + if (my $err = get_req(\@nodots,$_[0],$applykeys)) { return $err; } + while (my ($gn, $gv) = each %prop_h) + { + $proph_ptr->{$gn} = $gv; + } + foreach my $pkey ( keys %keyparam_h ) + { + my $k_found=0; + foreach my $verkey (split (/,/,$applykeys)) + { + if ($pkey eq $verkey) { $k_found = 1; } + } + if (! $k_found) { return $error{"apply_inv_param"}; } + } + + foreach my $applykey (split (/,/,$applykeys)) + { + while (my ($gn, $gv) = each %genparam_h) + { + $keyparshoh->{$applykey}{$gn} = $gv; + } + while (my ($kn, $kv) = each %{ $keyparam_h{$applykey} } ) + { + $keyparshoh->{$applykey}{$kn} = $kv; + } + push @$apply_keys_ptr, $applykey; + }#foreach + return 0; +} diff --git a/helm/hxsp/splitted/8.strrep.p.pl b/helm/hxsp/splitted/8.strrep.p.pl new file mode 100644 index 000000000..90557fefd --- /dev/null +++ b/helm/hxsp/splitted/8.strrep.p.pl @@ -0,0 +1,76 @@ +################################################################################################# +################################################################################################# +################################################################################################# +# Subrutines to replace values between {} on loaded templates +################################################################################################# +################################################################################################# +################################################################################################# + +sub ok_print +{ + my $message = shift(@_); + $message =~ s/(\n)/
\1/g; + my $retval = $ok_tpl; + $retval =~ s/\{MESSAGE\}/$message/g; + return $retval; +} + +sub operror_print +{ + my $message = shift(@_); + $message =~ s/(\n)/
\1/g; + my $retval = $operror_tpl; + $retval =~ s/\{ERROR\}/$message/g; + return $retval; +} + +sub synerror_print +{ + my $message = shift(@_); + my $us = shift(@_); + $message =~ s/(\n)/
\1/g; + my $retval = $synerror_tpl; + $retval =~ s/\{ERROR\}/$message/g; + $retval =~ s/\{USAGE\}/$us/g; + return $retval; +} + +################################################################################################# +################################################################################################# +################################################################################################# +# Subrutines to replace values between {} on loaded messages +################################################################################################# +################################################################################################# +################################################################################################# + +sub ok_replace +{ + my $message = shift(@_); + my $key = shift(@_); + my $s_uri = shift(@_); + $message =~ s/\{KEY\}/$key/g; + $message =~ s/\{URI\}/$s_uri/g; + return $message; +} + +sub err_replace +{ + my $message = shift(@_); + my $key = shift(@_); + my $s_uri = shift(@_); + my $errr = shift(@_); + $message =~ s/\{KEY\}/$key/g; + $message =~ s/\{URI\}/$s_uri/g; + $message =~ s/\{ERROR\}/$errr/g; + $message =~ s/\{OLDKEY\}/$errr/g; + return $message; +} + +sub parser_error_replace +{ + my $no_at = shift(@_); + $no_at =~ s/(.*)\sat\s(.*)/\1/g; + $no_at =~ s//>/g; + return $no_at; +} diff --git a/helm/hxsp/splitted/9.load.p.pl b/helm/hxsp/splitted/9.load.p.pl new file mode 100644 index 000000000..2746b273a --- /dev/null +++ b/helm/hxsp/splitted/9.load.p.pl @@ -0,0 +1,149 @@ +################################################################################################# +################################################################################################# +################################################################################################# +# Subrutines to load config files and templates +################################################################################################# +################################################################################################# +################################################################################################# + +sub load_messages +{ + if ($language eq "IT") + { + open(MESSAGE, "./msg/message.it") || die "Can't open config file '/msg/message.it' : $!"; + } + else + { + open(MESSAGE, "./msg/message.en") || die "Can't open config file '/msg/message.en' : $!"; + } + while(my $line = ) { + # ignore comments and full line comments + $line =~ s/#.*$//; + next unless $line =~ /\S/; + $line =~ s/\{URL\}/$puwobo_url/g; + $line =~ s/\{VER\}/$ver/g; + if ($line =~ /^(home_message)\s*=\s*(.*)$/) {$home_message = $2; } + if ($line =~ /^(help_message)\s*=\s*(.*)$/) {$help_message = $2; } + if ($line =~ /^(s_add)\s*=\s*(.*)$/) {$s_add = $2; } + if ($line =~ /^(s_reload)\s*=\s*(.*)$/) {$s_reload = $2; } + if ($line =~ /^(s_remove)\s*=\s*(.*)$/) {$s_remove = $2; } + if ($line =~ /^(list)\s*=\s*(.*)$/) {$list = $2; } + if ($line =~ /^(empty)\s*=\s*(.*)$/) {$empty = $2; } + if ($line =~ /^(all_usage)\s*=\s*(.*)$/) {$all_usage = $2; } + if ($all_usage_synerr eq "ON") + { + $help_usage=$add_usage=$remove_usage=$list_usage=$reload_usage=$apply_usage=$all_usage; + } + else + { + if ($line =~ /^(help_usage)\s*=\s*(.*)$/) {$help_usage = $2; } + if ($line =~ /^(add_usage)\s*=\s*(.*)$/) {$add_usage = $2; } + if ($line =~ /^(remove_usage)\s*=\s*(.*)$/) {$remove_usage = $2; } + if ($line =~ /^(list_usage)\s*=\s*(.*)$/) {$list_usage = $2; } + if ($line =~ /^(reload_usage)\s*=\s*(.*)$/) {$reload_usage = $2; } + if ($line =~ /^(apply_usage)\s*=\s*(.*)$/) {$apply_usage = $2; } + } + } + close MESSAGE; +} + +sub load_conf +{ + open(CONFIG, "./config") || die "Can't open config file 'config' : $!"; + while(my $line = ) { + # ignore comments and full line comments + $line =~ s/#.*$//; + next unless $line =~ /\S/; + if ($line =~ /^(working_path)\s*=\s*(.*)$/) {$working_path = $2; } + if ($line =~ /^(language)\s*=\s*(.*)$/) {$language = $2; } + if ($line =~ /^(port)\s*=\s*(.*)$/) {$port = $2; } + if ($line =~ /^(all_usage_synerr)\s*=\s*(.*)$/) {$all_usage_synerr = $2; } + if ($line =~ /^(expand_xinc)\s*=\s*(.*)$/) {$expand_xinc = $2; } + if ($line =~ /^(max_depth)\s*=\s*(.*)$/) {$max_depth = $2; } + } + close CONFIG; +} + +sub load_err +{ + if ($language eq "IT") + { + open(ERRO, "./msg/error.it") || die "Can't open config file '/msg/error.it' : $!"; + } + else + { + open(ERRO, "./msg/error.en") || die "Can't open config file '/msg/error.en' : $!"; + } + while(my $line = ) + { + # ignore comments and full line comments + $line =~ s/#.*$//; + next unless $line =~ /\S/; + if ($line =~ /^(.*?)\s*=\s*(.*)$/) {$error{$1} = $2; } + } + close ERRO; +} + +sub load_templates +{ + # load ok template + open(OK_TPL, "./tpl/ok.tpl") + || die "Can't open template file '/tpl/ok.tpl' : $!"; + while(my $line = ) {$ok_tpl .= $line; } + close OK_TPL; + + # load operror template + open(OPERROR_TPL, "./tpl/operror.tpl") + || die "Can't open template file '/tpl/operror.tpl' : $!"; + while(my $line = ) {$operror_tpl .= $line; } + close OPERROR_TPL; + + # load synerror template + open(SYNERROR_TPL, "./tpl/synerror.tpl") + || die "Can't open template file '/tpl/synerror.tpl' : $!"; + while(my $line = ) {$synerror_tpl .= $line; } + close SYNERROR_TPL; +} + +################################################################################################# +################################################################################################# +################################################################################################# +# the LibXML callbacks follow +# these callbacks are used for both the original parse AND the XInclude (if set) +################################################################################################# +################################################################################################# +################################################################################################# + +sub match_uri { + my $uri = shift; + return $uri !~ /:\/\// ? 1 : 0; # we handle only files +} + +sub open_uri { + my $uri = shift; + + my $handler = new IO::File; + if ( not $handler->open( "<$uri" ) ){ + $file = 0; + } + + return $file; +} + +sub read_uri { + my $handler = shift; + my $length = shift; + my $buffer = undef; + if ( $handler ) { + $handler->read( $rv , $length ); + } + return $buffer; +} + +sub close_uri { + my $handler = shift; + if ( $handler ) { + $handler->close(); + } + return 1; +} \ No newline at end of file diff --git a/helm/hxsp/tpl/ok.tpl b/helm/hxsp/tpl/ok.tpl new file mode 100644 index 000000000..633267e4e --- /dev/null +++ b/helm/hxsp/tpl/ok.tpl @@ -0,0 +1,5 @@ + + +{MESSAGE} + + diff --git a/helm/hxsp/tpl/operror.tpl b/helm/hxsp/tpl/operror.tpl new file mode 100644 index 000000000..4dbe1f56b --- /dev/null +++ b/helm/hxsp/tpl/operror.tpl @@ -0,0 +1,5 @@ + + +{ERROR} + + diff --git a/helm/hxsp/tpl/synerror.tpl b/helm/hxsp/tpl/synerror.tpl new file mode 100644 index 000000000..990df9cb5 --- /dev/null +++ b/helm/hxsp/tpl/synerror.tpl @@ -0,0 +1,6 @@ + + +{ERROR}
+{USAGE} + + -- 2.39.2