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
  32 sub data {
  33         my $self        = shift;
  34         my $data        = shift;
  35
  36         if (defined($data)) {
  37                 $self->{data} = $data;
  38         }
  39
  40         return $self->{data};
  41 }
  42
  43
  44 sub upload {
  45         my $self        = shift;
  46         my $dir         = shift;
  47         my $field       = shift;
  48
  49         my $file = $self->{cgi}->param($field);
  50         my ($basename) = ($file =~ /([^\/\\]+)$/);
  51
  52         if (! grep(/^$dir$/, $self->upload_dirs())) {
  53                 croak "Unauthorized upload directory $dir";
  54         }
  55
  56         my $filename = $dir . '/' . $basename;
  57
  58         open F, '>' . $filename or croak "Can't write $filename";
  59         while(<$file>) {
  60                 print F $_;
  61         }
  62
  63         close F;
  64 }
  65
  66
  67 sub new {
  68         my $class       = shift;
  69
  70         my $obj = bless( { @_ }, $class );
  71
  72         $obj->{http_headers} = {
  73                 'Content-Type'          => 'text/html; charset=ISO-8859-1',
  74                 'X-Gateway-Interface'   => $ENV{'GATEWAY_INTERFACE'},
  75                 'X-Server-Name'         => $ENV{'SERVER_NAME'}
  76         };
  77
  78         $obj->{upload_dirs} ||= [];
  79
  80         $obj->{cgi} = CGI->new();
  81
  82         return $obj;
  83 }
  84
  85
  86 sub run {
  87         my $self        = shift;
  88
  89         my $data = $self->data();
  90         my $vars = $self->vars();
  91
  92         $data->template->cgi_vars($vars);
  93
  94         if ($ENV{REMOTE_USER} and my $u = $data->user($ENV{REMOTE_USER})) {
  95                 $data->auth( $u );
  96         }
  97         elsif (my $cookie = $self->cookie()) {
  98                 if (my ($sid) = ($cookie =~ /^sid\s*=\s*(\d+)$/)) {
  99                         $data->auth_from_sid( $sid );
 100                 }
 101         }
 102
 103         my $st = 'INDEX';
 104
 105         if ($vars->{t}) {
 106                 $st = uc($vars->{t});
 107         }
 108
 109         $st = 'INDEX' unless $st =~ /^[-\w0-9_]+$/;
 110
 111         my $body = undef;
 112
 113         eval { $body = $data->template->process( $st ) };
 114
 115         if ($@) {
 116                 $data->log($@);
 117 #               $self->redirect('?t=INDEX');
 118                 $body = "<pre>$@</pre>";
 119         }
 120
 121         $self->http_headers('X-Powered-By' => 'Gruta ' . $self->data->version());
 122
 123         if (!$data->auth()) {
 124                 use Digest::MD5;
 125
 126                 my $md5 = Digest::MD5->new();
 127                 $md5->add($body);
 128
 129                 $self->http_headers('ETag' => $md5->hexdigest());
 130         }
 131
 132         my $h = $self->http_headers();
 133         foreach my $k (keys(%{ $h })) {
 134                 print $k, ': ', $h->{$k}, "\n";
 135         }
 136         print "\n";
 137
 138         print $body;
 139 }
 140
 141 1;