Changeset 766

Timestamp:

12/06/07 21:25:36 (1 year ago)

Author:

mart

Message:

• Now uses Perlbal's spangly new API functions to make embedding nicer/safer
  

• Uses Template Toolkit for the page, rather than hardcoding icky HTML into the Perl source.
  

Files:

• trunk/DJabberd-WebAdmin/lib/DJabberd/WebAdmin.pm (modified) (9 diffs)
• trunk/DJabberd-WebAdmin/stat (added)
• trunk/DJabberd-WebAdmin/stat/style.css (added)
• trunk/DJabberd-WebAdmin/templates (added)
• trunk/DJabberd-WebAdmin/templates/page.tt (added)

trunk/DJabberd-WebAdmin/lib/DJabberd/WebAdmin.pm

@@ -12 +12 @@
-package DJabberd::WebAdmin;
-
+# Need 5.8 because we use PerlIO
+require 5.008;
+
-use strict;
-
+ # FIXME: Once a release of Perlbal with the new API has actually been made, require that version explicitly here
-use Perlbal::Plugin::Cgilike;
+use Symbol;
+use Template;
-
-use base qw(DJabberd::Plugin);
@@ -21 +26 @@
-
-my $server = undef;
+
+my $tt = Template->new({
+    INCLUDE_PATH => 'templates',
+    
+    START_TAG => quotemeta("[["),
+    END_TAG => quotemeta("]]"),
+    PRE_CHOMP => 2, # CHOMP_COLLAPSE
+    POST_CHOMP => 2, # CHOMP_COLLAPSE
+    RECURSION => 1,
+});
+
+sub set_config_listenaddr {
+    my ($self, $addr) = @_;
+    
+    $self->{listenaddr} = DJabberd::Util::as_bind_addr($addr);
+
+    # We default to localhost if no interface is specified
+    # User can explicitly say 0.0.0.0: to bind to everything.
+    $self->{listenaddr} = "127.0.0.1:".$self->{listenaddr} if $self->{listenaddr} =~ /^\d+$/;
+}
-
-sub finalize {
-    my ($self) = @_;
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-    
-    # Hopefully by this point Perlbal's screwed around enough with Danga::Socket
@@ -78 +92 @@
-    my ($r) = @_;
-
+    my $path = $r->path;
+
+    # If the URL starts with /_/ then it's a static file request.
+    if ($path =~ m!^/_/(\w+)$!) {
+        my $resource_name = $1;
+        return handle_static_resource($r, $resource_name);
+    }
+    # which we just let Perlbal handle itself.
+    return Perlbal::Plugin::Cgilike::DECLINED if ($path =~ m!^/_/!);
+
-    # All valid paths end with a slash
-    # (because it makes it easier to construct relative links)
-    my $path = $r->path;
-    if (substr($path, -1) ne '/') {
-        $r->response_status_code(302);
@@ -90 +113 @@
-    my $page = determine_page_for_request($r);
-    
+    unless (ref $page) {
+        # It's a string containing a relative URL to redirect to
+        $r->response_status_code(302);
+        $r->response_header('Location' => $path.$page);
+        print "...";
+        return Perlbal::Plugin::Cgilike::HANDLED;
+    }
+    
-    if ($page) {
-        output_page($r, $page);
@@ -101 +132 @@
-}
-
+sub handle_static_resource {
+    my ($r, $name) = @_;
+    
+    my $fn = undef;
+    my $type = undef;
+    
+    if ($name eq 'style') {
+        $fn = 'stat/style.css';
+        $type = 'text/css';
+    }
+    else {
+        $fn = 'stat/'.$name.'.png';
+        $type = 'image/png';
+    }
+
+    return 404 unless defined($fn) && -f $fn;
+    
+    $r->response_header('Content-type' => $type);
+    $r->send_response_header();
+    
+    # FIXME: Should really add an API to Cgilike's $r for this, which can then use sendfile
+    # This is lame.
+    
+    return 404 unless open (STATFILE, '<', $fn);
+    
+    # FIXME: Really should to binmode() the fh underlying $r, but no nice API for this right now
+    #    and DJabberd doesn't work on Windows anyway.
+    binmode STATFILE;
+    
+    my $buf = "";
+    while (read(STATFILE, $buf, 1024)) {
+        print $buf;
+    }
+    
+    close(STATFILE);
+    
+    return Perlbal::Plugin::Cgilike::HANDLED;
+}
+
-sub determine_page_for_request {
-    my ($r) = @_;
@@ -118 +188 @@
-    
-    if (scalar(@pathbits) == 0) {
-
+
+
+
+
+
+
+
+
+
-    }
-    
@@ -133 +211 @@
-sub output_page {
-    my ($r, $page) = @_;
-
+
-    my $title = $page->title;
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-}
-
@@ -228 +351 @@
-    # FIXME: Should add some accessors to DJabberd::VHost to get this stuff, rather than
-    #    grovelling around inside.
-2>Client Sessions</h2
+3>Client Sessions</h3
-    print "<ul>";
-    foreach my $jid (keys %{$vhost->{jid2sock}}) {
@@ -236 +359 @@
-    print "</ul>";
-    
-2>Plugins Loaded</h2
+3>Plugins Loaded</h3
-    print "<ul>";
-    foreach my $class (keys %{$vhost->{plugin_types}}) {