Gruta/CGI.pm

   1 package Gruta::CGI;
   2
   3 use CGI;
   4 use Carp;
   5
   6 sub vars { return $_[0]->{cgi}->Vars(); }
   7 sub upload_dirs { return @{ $_[0]->{upload_dirs} }; }
   8
   9 sub http_headers {
  10         my $self        = shift;
  11         my %headers     = @_;
  12
  13         foreach my $k (keys(%headers)) {
  14                 $self->{http_headers}->{$k} = $headers{$k};
  15         }
  16
  17         return $self->{http_headers};
  18 }
  19
  20 sub cookie {
  21         my $self        = shift;
  22
  23         if (@_) {
  24                 $self->http_headers( 'Set-Cookie', shift );
  25         }
  26
  27         return $ENV{HTTP_COOKIE};
  28 }
  29
  30 sub redirect { $_[0]->http_headers( 'Location', $_[1] ); }
  31 sub status { $_[0]->http_headers( 'Status', $_[1] ); }
  32
  33 sub data {
  34         my $self        = shift;
  35         my $data        = shift;
  36
  37         if (defined($data)) {
  38                 $self->{data} = $data;
  39         }
  40
  41         return $self->{data};
  42 }
  43
  44
  45 sub upload {
  46         my $self        = shift;
  47         my $dir         = shift;
  48         my $field       = shift;
  49
  50         my $file = $self->{cgi}->param($field);
  51         my ($basename) = ($file =~ /([^\/\\]+)$/);
  52
  53         if (! grep(/^$dir$/, $self->upload_dirs())) {
  54                 croak "Unauthorized upload directory $dir";
  55         }
  56
  57         my $filename = $dir . '/' . $basename;
  58
  59         open F, '>' . $filename or croak "Can't write $filename";
  60         while(<$file>) {
  61                 print F $_;
  62         }
  63
  64         close F;
  65 }
  66
  67
  68 sub new {
  69         my $class       = shift;
  70
  71         my $obj = bless( { @_ }, $class );
  72
  73         $obj->{charset} ||= 'UTF-8';
  74
  75         $obj->{http_headers} = {
  76                 'Content-Type'          => 'text/html; charset=' . $obj->{charset},
  77                 'X-Gateway-Interface'   => $ENV{'GATEWAY_INTERFACE'},
  78                 'X-Server-Name'         => $ENV{'SERVER_NAME'}
  79         };
  80
  81         $obj->{upload_dirs} ||= [];
  82
  83         $obj->{cgi} = CGI->new();
  84
  85         return $obj;
  86 }
  87
  88
  89 sub run {
  90         my $self        = shift;
  91
  92         my $data = $self->data();
  93         my $vars = $self->vars();
  94
  95         $data->template->cgi_vars($vars);
  96
  97         if ($ENV{REMOTE_USER} and my $u = $data->user($ENV{REMOTE_USER})) {
  98                 $data->auth( $u );
  99         }
 100         elsif (my $cookie = $self->cookie()) {
 101                 if (my ($sid) = ($cookie =~ /^sid\s*=\s*(\d+)$/)) {
 102                         $data->auth_from_sid( $sid );
 103                 }
 104         }
 105
 106         my $st = 'INDEX';
 107
 108         if ($vars->{t}) {
 109                 $st = uc($vars->{t});
 110         }
 111
 112         $st = 'INDEX' unless $st =~ /^[-\w0-9_]+$/;
 113
 114         # not identified nor users found?
 115         if (!$data->auth() && ! $data->users()) {
 116
 117                 # create the admin user
 118                 my $u = Gruta::Data::User->new(
 119                         id              => 'admin',
 120                         is_admin        => 1,
 121                         can_upload      => 1,
 122                         username        => 'Admin',
 123                         email           => 'webmaster@localhost'
 124                 );
 125
 126                 # set a random password (to be promptly changed)
 127                 $u->password(rand());
 128
 129                 # insert the user
 130                 $data->insert_user($u);
 131
 132                 # create a new session
 133                 my $session = Gruta::Data::Session->new(user_id => 'admin');
 134                 $u->source->insert_session($session);
 135
 136                 my $sid = $session->get('id');
 137                 $self->cookie("sid=$sid");
 138
 139                 $data->auth($u);
 140
 141                 $st = 'ADMIN';
 142         }
 143
 144         my $body = undef;
 145
 146         eval { $body = $data->template->process( $st ) };
 147
 148         if ($@) {
 149                 $data->log($@);
 150 #               $self->redirect('?t=INDEX');
 151                 $body = "<pre>$@</pre>";
 152         }
 153
 154         $self->http_headers('X-Powered-By' => 'Gruta ' . $self->data->version());
 155
 156         if (!$data->auth()) {
 157                 use Digest::MD5;
 158                 use Encode qw(encode_utf8);
 159
 160                 my $md5 = Digest::MD5->new();
 161                 $md5->add(encode_utf8($body));
 162                 my $etag = $md5->hexdigest();
 163
 164                 my $inm = $ENV{HTTP_IF_NONE_MATCH} || '';
 165
 166                 if ($inm eq $etag) {
 167                         $self->status(304);
 168                         $body = '';
 169                 }
 170                 else {
 171                         $self->http_headers('ETag' => $etag);
 172                 }
 173         }
 174
 175         my $h = $self->http_headers();
 176         foreach my $k (keys(%{ $h })) {
 177                 print $k, ': ', $h->{$k}, "\n";
 178         }
 179         print "\n";
 180
 181         print $body;
 182 }
 183
 184 1;