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-Powered-By'          => 'Gruta',
  75                 'X-Gateway-Interface'   => $ENV{'GATEWAY_INTERFACE'},
  76                 'X-Server-Name'         => $ENV{'SERVER_NAME'}
  77         };
  78
  79         $obj->{upload_dirs} ||= [];
  80
  81         $obj->{cgi} = CGI->new();
  82
  83         return $obj;
  84 }
  85
  86
  87 sub run {
  88         my $self        = shift;
  89
  90         my $data = $self->data();
  91         my $vars = $self->vars();
  92
  93         $data->template->cgi_vars($vars);
  94
  95         if ($ENV{REMOTE_USER} and my $u = $data->user($ENV{REMOTE_USER})) {
  96                 $data->auth( $u );
  97         }
  98         elsif (my $cookie = $self->cookie()) {
  99                 if (my ($sid) = ($cookie =~ /^sid\s*=\s*(\d+)$/)) {
 100                         $data->auth_from_sid( $sid );
 101                 }
 102         }
 103
 104         my $st = 'INDEX';
 105
 106         if ($vars->{t}) {
 107                 $st = uc($vars->{t});
 108         }
 109
 110         $st = 'INDEX' unless $st =~ /^[-\w0-9_]+$/;
 111
 112         my $body = undef;
 113
 114         eval { $body = $data->template->process( $st ) };
 115
 116         if ($@) {
 117                 $data->log($@);
 118 #               $self->redirect('?t=INDEX');
 119                 $body = "<pre>$@</pre>";
 120         }
 121
 122         $body = $data->special_uris($body);
 123
 124         my $h = $self->http_headers();
 125         foreach my $k (keys(%{ $h })) {
 126                 print $k, ': ', $h->{$k}, "\n";
 127         }
 128         print "\n";
 129
 130         print $body;
 131 }
 132
 133 1;