lib/POE/Component/IRC/Plugin/NoPaste/Httpd.pm

   1 # -*- cperl -*-
   2 package POE::Component::IRC::Plugin::NoPaste::Httpd;
   3 use strict;
   4 use warnings;
   5 require Exporter;
   6 BEGIN {
   7     # with out this BEGIN block, NoPaste::Httpd::* can't import them by Exporter.
   8     our @ISA = qw(Exporter);
   9     our @EXPORT = qw(
  10         notfound_handler
  11         need_auth_handler
  12         redirect_handler
  13         internal_server_error_handler);
  14 }
  15 use POE qw(
  16            Component::Server::HTTP
  17            Component::IRC::Plugin::NoPaste::Template
  18            Component::IRC::Plugin::NoPaste::StaticFile
  19            Component::IRC::Plugin::NoPaste::Httpd::Index
  20            Component::IRC::Plugin::NoPaste::Httpd::Pasted
  21           );
  22 use CGI::Pretty qw(:standard);
  23 use HTTP::Status;
  24 use Carp;
  25 use Hash::Util qw(lock_keys);
  26
  27 sub spawn {
  28     my ($class, $nopaste) = @_;
  29     my $this = bless {} => $class;
  30
  31     $this->{nopaste} = $nopaste;
  32
  33     $this->{my_alias} = undef;
  34     $this->{httpd_alias} = undef;
  35
  36     lock_keys %$this;
  37
  38     POE::Session->create(
  39         heap => $this,
  40         package_states => [
  41             __PACKAGE__, [ qw(_start shutdown) ],
  42            ],
  43        );
  44
  45     $this->{my_alias};
  46 }
  47
  48 sub _start {
  49     my $this = $_[HEAP];
  50
  51     $this->{my_alias} = 'PCI::Plugin::NoPaste::Httpd::' . $_[SESSION]->ID;
  52     $_[KERNEL]->alias_set($this->{my_alias});
  53
  54     my $barrier = sub {
  55         my $code = $_[0];
  56         return sub {
  57             my ($req, $resp) = @_;
  58
  59             local $ENV{OUTPUT_CHARSET} = 'UTF-8';
  60
  61             # copy the content of POST to query if needed.
  62             if ($req->method eq 'POST' and
  63                   $req->headers->content_type eq 'application/x-www-form-urlencoded' and
  64                     !defined $req->uri->query) {
  65                 $_ = $req->content;
  66                 tr/\x0d\x0a//d;
  67                 $req->uri->query($_);
  68             }
  69
  70             my $last_exception;
  71             my $retval = eval {
  72                 local $SIG{__DIE__} = sub {
  73                     print $_[0];
  74                     $last_exception = Carp::longmess(@_);
  75                 };
  76
  77                 $code->($this, @_);
  78             }; if ($@) {
  79                 $retval = $this->internal_server_error_handler(
  80                     $req, $resp, $last_exception);
  81             }
  82
  83             # complete the response
  84             $resp->code or
  85               $resp->code($retval);
  86             $resp->message or
  87               $resp->message(status_message($resp->code));
  88
  89             if (!length $resp->content) {
  90                 if ($resp->code >= 200 && $resp->code < 300) {
  91                     $retval = $this->internal_server_error_handler(
  92                         $req, $resp, 'Content handler did not set any content.');
  93                 }
  94                 elsif ($resp->code >= 300 && $resp->code < 400) {
  95                     # FIXME: complete a HTML which links to the destination of redirection
  96                 }
  97             }
  98
  99             # default value of Content-Type is text/html
 100             $resp->header('Content-Type') or
 101               $resp->header('Content-Type' => 'text/html; charset=UTF-8');
 102
 103             # complete Content-Length
 104             $resp->header('Content-Length') or
 105               $resp->header('Content-Length' => length($resp->content));
 106
 107             # remove content if the method is HEAD
 108             if ($req->method eq 'HEAD') {
 109                 $resp->content(undef);
 110             }
 111
 112             return $retval;
 113         };
 114     };
 115
 116     $this->{httpd_alias} = POE::Component::Server::HTTP->new(
 117         Port => $this->{nopaste}{config}{httpd}{port},
 118         ContentHandler => {
 119             '/'
 120               => $barrier->(\&notfound_handler),
 121             '/css/'
 122               => $barrier->(\&css_handler),
 123             '/nopaste/'
 124               => $barrier->(\&POE::Component::IRC::Plugin::NoPaste::Httpd::Index::handler),
 125             '/post/'
 126               => $barrier->(\&POE::Component::IRC::Plugin::NoPaste::Httpd::Index::handler),
 127             '/pasted/'
 128               => $barrier->(\&POE::Component::IRC::Plugin::NoPaste::Httpd::Pasted::handler),
 129         },
 130         Headers => {
 131             Server => 'PCI::Plugin::NoPaste UI (Powered by PoCo::Server::HTTP)',
 132             Connection => 'close',
 133         },
 134        )->{httpd};
 135 }
 136
 137 sub shutdown {
 138     my $this = $_[HEAP];
 139
 140     $_[KERNEL]->alias_remove($this->{my_alias});
 141     $_[KERNEL]->call($this->{httpd_alias} => 'shutdown');
 142 }
 143
 144 sub notfound_handler {
 145     my ($this, $req, $resp) = @_;
 146     my $t = POE::Component::IRC::Plugin::NoPaste::Template->new(
 147         -data => static_file('tmpl/error.html'));
 148     $t->expand(
 149         status_code => '404',
 150         status_message => 'Not Found',
 151         requested_url => ''.$req->uri,
 152     );
 153     $resp->content($t->str);
 154     return RC_NOT_FOUND;
 155 }
 156
 157 sub css_handler {
 158     my ($this, $req, $resp) = @_;
 159     (my $path = $req->uri->path) =~ s|^/css/||;
 160     my $content = static_file('css/'.$path);
 161
 162     if (defined $content) {
 163         $resp->header('Content-Type' => 'text/css; charset=UTF-8');
 164         $resp->content($content);
 165         return RC_OK;
 166     }
 167     else {
 168         return notfound_handler(@_);
 169     }
 170 }
 171
 172 sub internal_server_error_handler {
 173     my ($this, $req, $resp, $error) = @_;
 174
 175     my $style = {
 176         -style => 'white-space: pre;',
 177     };
 178
 179     my $html = join '',
 180       start_html(
 181           -title    => 'Internal Server Error',
 182           -encoding => 'UTF-8',
 183          ),
 184         h1('Internal Server Error'),
 185           h2('Request'),
 186             p($style, $req->as_string),
 187           h2('Error'),
 188             p($style, $error),
 189       end_html;
 190
 191     $resp->code(RC_INTERNAL_SERVER_ERROR);
 192     $resp->message(status_message($resp->code));
 193     $resp->header('Content-Type' => 'text/html; charset=UTF-8');
 194     $resp->content($html);
 195     return RC_INTERNAL_SERVER_ERROR;
 196 }
 197
 198 sub redirect_handler {
 199     # $req : HTTP::Request
 200     # $resp: HTTP::Response
 201     # $path: destination of the redirection
 202     # $query_hash: query (can be undef)
 203     my ($this, $req, $resp, $path, $query_hash) = @_;
 204
 205     $resp->header(Location => do {
 206         my $uri = $req->uri->clone;
 207         $uri->path($path);
 208         $uri->query(undef);
 209         $query_hash and
 210           $uri->query_form_hash($query_hash);
 211         $uri->fragment(undef);
 212         $uri->as_string;
 213     });
 214     return RC_SEE_OTHER;
 215 }
 216
 217 1;