* WML: Backport changes from module HTTPD

3 files changed, 190 insertions, 56 deletions

diff --git a/lib/XXV/MODULES/EPG.pm b/lib/XXV/MODULES/EPG.pm
index c56f250..1db3e29 100644
--- a/lib/XXV/MODULES/EPG.pm
+++ b/lib/XXV/MODULES/EPG.pm
@@ -905,7 +905,8 @@ order by
     my $info = {
       rows => $rows
     };
-    if($console->typ eq 'HTML') {
+    if($console->typ eq 'HTML' 
+        || $console->typ eq 'WML') {
       $info->{channels} = $cmod->ChannelWithGroup('c.name,c.hash');
       $info->{current} = $cid;
     }
diff --git a/lib/XXV/MODULES/WAPD.pm b/lib/XXV/MODULES/WAPD.pm
index 6005202..f63c29b 100644
--- a/lib/XXV/MODULES/WAPD.pm
+++ b/lib/XXV/MODULES/WAPD.pm
@@ -171,6 +171,8 @@ sub init {
                     # read new line and report it
                     my $handle=$watcher->w->fd;
 
+                    my $ip = getip($handle);
+
                     my $data = $self->parseRequest($handle,(defined $self->{LOGOUT} && $self->{LOGOUT} == 1 ));
                     unless($data) {
                         undef $self->{LOGOUT};
@@ -236,6 +238,25 @@ sub init {
                             $console->footer();
                         }
                     }
+
+                    # make entry more readable
+		                $data->{Query} =~ s/%([a-f0-9][a-f0-9])/pack("C", hex($1))/ieg 
+                      if($data->{Query});
+		                $data->{Referer} =~ s/%([a-f0-9][a-f0-9])/pack("C", hex($1))/ieg
+                      if($data->{Referer});
+                    # Log like Apache Format ip, resolved hostname, user, method request, status, bytes, referer, useragent
+                    lg sprintf('%s - %s "%s %s%s" %s %s "%s" "%s"',
+                          $ip,
+                          $data->{username} ? $data->{username} : "-",
+                          $data->{Method},
+                          $data->{Request} ? $data->{Request} : "",
+                          $data->{Query} ? "?" . $data->{Query} : "",
+                          $console->{'header'},
+                          $console->{'sendbytes'},
+                          $data->{Referer} ? $data->{Referer} : "-",
+                          "-" #$data->{http_useragent} ? $data->{http_useragent} : ""
+                        );
+
                     $watcher->w->cancel;
                     undef $watcher;
                     $handle->close();
@@ -250,41 +271,94 @@ sub init {
 }
 
 # ------------------
+sub _readline {
+# ------------------
+    my $fh = $_[0];
+    my $c='';
+    my $line='';
+    my $eof=0;
+
+    while ($c ne "\n" && ! $eof) {
+    	if (sysread($fh, $c, 1) > 0) {
+        $line = $line . $c;
+      } else {
+        $eof=1;
+      }
+    }
+    return $line;
+}
+# ------------------
 sub parseRequest {
 # ------------------
     my $self = shift || return error('No object defined!');
-    my $hdl = shift || return error('No handle defined!');
+    my $socket = shift || return error('No handle defined!');
     my $logout = shift || 0;
 
-    my ($Req, $size) = getFromSocket($hdl);
-
-       if($Req->[0] =~ /^GET (\/[\w\.\/-\:\%]*)([\?[\w=&\.\+\%-\:\!]*]*)[\#\d ]+HTTP\/1.\d$/) {
-        my $data = {};
-		($data->{Request}, $data->{Query}) = ($1, $2 ? substr($2, 1, length($2)) : undef);
-
-    	# parse header
-    	foreach my $line (@$Req) {
-    		if($line =~ /Referer: (.*)/) {
+    binmode $socket;
+   	my $data = {};
+    my $line;
+    while (defined($line = &_readline($socket))) {
+        if(!$line || $line eq "\r\n") {
+    			last;
+        } elsif(!$data->{Method} && $line =~ /^(\w+) (\/[\w\.\/\-\:\%]*)([\?[\w=&\.\+\%-\:\!]*]*)[\#\d ]+HTTP\/1.\d/) {
+    			($data->{Method}, $data->{Request}, $data->{Query}) = ($1, $2, $3 ? substr($3, 1, length($3)) : undef);
+        } elsif($line =~ /Referer: (.*)/) {
     			$data->{Referer} = $1;
-    		}
-    		if($line =~ /Host: (.*)/) {
+    	  	$data->{Referer} =~ s/(\r|\n)//g;
+    		} elsif($line =~ /Host: (.*)/) {
     			$data->{HOST} = $1;
-    		}
-    		if($line =~ /Authorization: basic (.*)/i and not $logout) {
+    	  	$data->{HOST} =~ s/(\r|\n)//g;
+    		} elsif($line =~ /Authorization: basic (.*)/i and not $logout) {
     			($data->{username}, $data->{password}) = split(":", MIME::Base64::decode_base64($1), 2);
-    		}
-    		if($line =~ /User-Agent: (.*)/i) {
+    		} elsif($line =~ /User-Agent: (.*)/i) {
     			$data->{http_useragent} = $1;
+    	  	$data->{http_useragent} =~ s/(\r|\n)//g;
+    		} elsif($line =~ /Accept-Encoding:.+?gzip/i) {
+    			$data->{accept_gzip} = 1;
+    		} elsif($line =~ /If-None-Match: (\S+)/i) {
+    			$data->{Match} = $1;
+    		} elsif($line =~ /Cookie: (\S+)=(\S+)/i) {
+    			$data->{$1} = $2;
+    		} elsif($line =~ /Content-Type: (\S+)/i) {
+    			$data->{ContentType} = $1;
+    		} elsif($line =~ /Content-Length: (\S+)/i) {
+    			$data->{ContentLength} = $1;
     		}
-    	}
-        $data->{Request} =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
+        $self->{STATUS}->{'readbytes'} += length($line);
+      }
+   
+	$data->{Request} =~ s/%([a-f0-9][a-f0-9])/pack("C", hex($1))/ieg
+    if($data->{Request});
+  if($data->{Method}) {
+    if($data->{Method} eq 'GET' 
+      or $data->{Method} eq 'HEAD') {
+      return $data;
+    } elsif($data->{Method} eq 'POST') {
+      if(int($data->{ContentLength})>0) {
+        my $post;
+        my $bytes = sysread($socket,$post,$data->{ContentLength});
+        $data->{Post} = $post
+          if($bytes && $data->{ContentLength} == $bytes);
+        $self->{STATUS}->{'readbytes'} += $bytes;
+      }
+      return $data;
+    } else {
+      lg sprintf("Unsupported HTTP Method : %s",$data->{Method});
+    }
+  }
+  return undef;
+}
 
-        return $data;
-	} else {
-           error sprintf("Unknown Request: <%s>\n", join("\n", @$Req));
-	   return;
-	}
+# ------------------
+sub ModulNotLoaded {
+# ------------------
+    my $self     = shift || return error('No object defined!');
+    my $console = shift || return error('No console defined!');
+    my $module = shift || return error('No module defined!');
 
+    $console->statusmsg(500,
+          ,sprintf(gettext("Module '%s' is'nt loaded!"),$module),
+          ,gettext("Internal Server Error"));
 }
 
 # ------------------
@@ -292,7 +366,7 @@ sub handleInput {
 # ------------------
     my $self     = shift || return error('No object defined!');
     my $console = shift || return error('No console defined!');
-    my $cgi     = shift || return error ('No CGI Object');
+    my $cgi     = shift || return error('No CGI object defined!');
 
     my $ucmd    = $cgi->param('cmd')  || '<undef>';
     my $udata   = $cgi->param('data') || '';
@@ -318,15 +392,41 @@ sub handleInput {
 
     # Test the command on exists, permissions and so on
     my $u = main::getModule('USER');
-    my ($cmdobj, $cmdname, $shorterr, $err) = $u->checkCommand($console, $ucmd);
-    $console->{call} = $cmdname;
-    if($cmdobj and not $shorterr) {
-        $cmdobj->{callback}($console, $udata, $result );
-    } elsif($shorterr eq 'noperm' or $shorterr eq 'noactive') {
-        return $console->status403($err);
+    if($u) {
+      my ($cmdobj, $cmdname, $cmdModule, $shorterr, $err) = $u->checkCommand($console, $ucmd);
+      $console->setCall($cmdname);
+      if($cmdobj and not $shorterr) {
+
+          if($cmdobj->{binary}) {
+            $console->{nocache} = 1 
+                if($cmdobj->{binary} eq 'nocache');
+          }
+          $cmdobj->{callback}($console, $console->{USER}->{config}->{$cmdModule}, $udata, $result );
+      } elsif($shorterr eq 'noperm' or $shorterr eq 'noactive') {
+          $console->status403($err);
+      } else {
+          $self->_usage($console, undef, $err);
+      } 
+    } else {
+      $self->ModulNotLoaded($console,'USER');
+    }
+}
+
+# ------------------
+sub _usage {
+# ------------------
+    my $self = shift || return error('No object defined!');
+    my $console = shift || return error('No console defined!');
+    my $modulename = shift;
+    my $hint = shift;
+
+    my $m = main::getModule('CONFIG');
+    if ($m){
+      return $m->usage($console,undef, $modulename,$hint);
     } else {
-        return $self->usage($console, undef, $err);
+      $self->ModulNotLoaded($console,'CONFIG');
     }
+
 }
 
 
diff --git a/lib/XXV/OUTPUT/Wml.pm b/lib/XXV/OUTPUT/Wml.pm
index d2852d4..2168737 100644
--- a/lib/XXV/OUTPUT/Wml.pm
+++ b/lib/XXV/OUTPUT/Wml.pm
@@ -116,7 +116,6 @@ sub parseTemplate {
     my $data = shift || return error('No data defined!');
     my $params = shift || {};
 
-    my $t = $self->{tt};
     my $u = main::getModule('USER');
 
     # you can use two templates, first is a user defined template
@@ -171,8 +170,8 @@ sub parseTemplate {
             }
         },
     };
-    $t->process($widget, $vars, \$output)
-          or return error($t->error());
+    $self->{tt}->process($widget, $vars, \$output)
+          or return error($self->{tt}->error());
 
     return $output;
 }
@@ -185,14 +184,13 @@ sub out {
     my $type = shift || 'text/vnd.wap.wml';
     my %args = @_;
 
-    my $q = $self->{cgi};
     unless(defined $self->{header}) {
         # HTTP Header
-        $self->{handle}->print(
-            $self->header($type, \%args)
-        );
+        my $header = $self->header($type, \%args);
+        $self->{sendbytes}+= length($header);
+        $self->{handle}->print($header );
     }
-
+    $self->{sendbytes}+= length($text)+ 2;
     $self->{handle}->print( $text,"\r\n" );
 }
 
@@ -203,7 +201,7 @@ sub header {
     my $typ = shift || return error ('No Type!' );
     my $arg = shift || {};
 
-    $self->{header} = 1;
+    $self->{header} = 200;
     return $self->{cgi}->header(
         -type   =>  $typ,
         -status  => "200 OK",
@@ -217,24 +215,60 @@ sub header {
 sub statusmsg {
 # ------------------
     my $self = shift  || return error('No object defined!');
-    my $msg = shift || return error ('No Msg!');
-    my $status = shift || return error ('No Status!');
+    my $state = shift || return error('No state defined!');
+    my $msg = shift;
+    my $title = shift;
+    my $typ = shift || 'text/vnd.wap.wml';
 
     unless(defined $self->{header}) {
         $self->{nopack} = 1;
-        $self->{header} = 1;
+
+        my $s = {
+            200 => '200 OK',
+            204 => '204 No Response',
+            301 => '301 Moved Permanently',
+            302 => '302 Found',
+            303 => '303 See Other',
+            304 => '304 Not Modified',
+            307 => '307 Temporary Redirect',
+            400 => '400 Bad Request',
+            401 => '401 Unauthorized',
+            403 => '403 Forbidden',
+            404 => '404 Not Found',
+            405 => '405 Not Allowed',
+            408 => '408 Request Timed Out',
+            500 => '500 Internal Server Error',
+            503 => '503 Service Unavailable',
+            504 => '504 Gateway Timed Out',
+        };
+        my $status = $s->{200};
+        $status = $s->{$state}
+            if(exists $s->{$state});
+
+        my $arg = {};
+
+        $arg->{'Location'} = $msg
+            if($state == 301);
+
+        $arg->{'WWW-Authenticate'} = "Basic realm=\"xxvd\""
+            if($state == 401);
+
+        $arg->{'expires'} = (($state != 304) || (defined $self->{nocache} && $self->{nocache})) ? "now" : "+7d";
+
+        $self->{header} = $state;
         my $data = $self->{cgi}->header(
-            -type   =>  'text/vnd.wap.wml',
+            -type   =>  $typ,
             -status  => $status,
-            -expires => "now",
+            -charset => $self->{charset},
+            %{$arg},
         );
         $self->out($data);
     }
-
-    my @title = split ('\n', $status);
-    $self->start(undef,{ title => $title[0] });
-    $self->err($msg);
-    $self->footer();
+    if($msg && $title) {
+        $self->start(undef,{ title => $title });
+        $self->err($msg);
+        $self->footer();
+    }   
 }
 
 # ------------------
@@ -244,7 +278,7 @@ sub login {
     my $self = shift || return error('No object defined!');
     my $msg = shift || '';
 
-    $self->statusmsg($msg,"401 Authorization Required\nWWW-Authenticate: Basic realm=\"xxvd\"");
+    $self->statusmsg(401,$msg,gettext("Authorization required"));
 }
 
 # ------------------
@@ -254,7 +288,7 @@ sub status403 {
     my $self = shift  || return error('No object defined!');
     my $msg = shift  || '';
 
-    $self->statusmsg($msg,"403 Forbidden");
+    $self->statusmsg(403,$msg,gettext("Forbidden"));
 }
 
 
@@ -266,11 +300,10 @@ sub status404 {
     my $file = shift || return error('No file defined!');
     my $why = shift || "";
 
-    lg sprintf("Couldn't open file '%s' : %s!",$file,$why);
-
     $file =~ s/$self->{wmldir}\///g; # Don't post wml root, avoid spy out
 
-    $self->statusmsg(sprintf(gettext("Couldn't open file '%s' : %s!"),$file,$why),"404 File not found");
+    $self->statusmsg(404,sprintf(gettext("Couldn't open file '%s' : %s!"),$file,$why),
+                    gettext("Not found"));
 }
 
 # ------------------