Yuki Kimoto's Perl Blog

How to serve Static HTML file and CGI script in development environment.

I write simple implementation with Mojolicious.

morbo serve_cgi.pl

#!/usr/bin/env perl

use strict;

use warnings;

use Mojo::Message::Response;

use File::Temp 'tempfile';

warn "Server start\n";

my $cmd = 'giblog build';

system($cmd) == 0

  or die "Can't execute $cmd: $!";

use Mojolicious::Lite;

# render CGI

app->hook(before_dispatch => sub {

  my $c = shift;

  

  my $req = $c->req;

  

  my $path = $req->url->path->clone;

  

  if ($path =~ /\.cgi$/) {

    

    # Prevent directory traversal

    $path->canonicalize;

    if ($path =~ /^[\\\/]\./) {

      die "Can't contain \. in path \"$path\"";

    }

    my $method = $c->req->method;

    my $script_name = $c->app->home->rel_file("public/$path");

    

    # CGI Environment variable

    local $ENV{AUTH_TYPE} = '';

    local $ENV{CONTENT_LENGTH} = $req->headers->content_length;

    local $ENV{CONTENT_TYPE} = $req->headers->content_type;

    local $ENV{GATEWAY_INTERFACE} = 'CGI/1.1';

    local $ENV{PATH_INFO} = $req->url->path;

    local $ENV{PATH_TRANSLATED} = $req->url->path;

    local $ENV{QUERY_STRING} = $req->url->query->to_string;

    local $ENV{REMOTE_ADDR} = $c->tx->remote_address;

    local $ENV{REMOTE_HOST} = $c->tx->remote_address;

    local $ENV{REMOTE_IDENT} = '';

    local $ENV{REMOTE_USER} = '';

    local $ENV{REQUEST_METHOD} = $method;

    local $ENV{SCRIPT_NAME} = $script_name;

    local $ENV{SERVER_NAME} = 'localhost';

    local $ENV{SERVER_PORT} = $c->tx->remote_port;

    local $ENV{SERVER_SOFTWARE} = "Mojolicious (Perl)";

    local $ENV{SERVER_PROTOCOL} = 'HTTP/1.1';

    

    # Check script name

    unless ($script_name =~ /^[a-zA-Z_0-9\/\-\.]+$/) {

      die "Invalid script name";

    }

    

    # Check existance of CGI script

    unless (-f $script_name) {

      die "Not found CGI script";

    }

    

    # Run CGI script

    my $output;

    if ($method eq 'GET') {

      # GET requst

      $output = `$^X $script_name`;

      if ($?) {

        $c->res->code('505');

        $c->render(text => "Internal Server Error");

      }

    }

    elsif ($method eq 'POST') {

      # POST request

      my $body = $req->body;

      my ($in_fh, $in_file) = tempfile;

      print $in_fh $body;

      close $in_fh;

      $output = `$^X -pe "" $in_file | $^X $script_name`;

      if ($?) {

        $c->res->code('505');

        $c->render(text => "Internal Server Error");

      }

      unlink $in_file;

    }

    

    # Header part and body part

    my ($header_part, $body_part) = split("\n\n", $output, 2);

    

    # Response

    my $res = Mojo::Message::Response->new;

    while (!$res->is_finished) {

      $res->parse($header_part);

    }

    $c->res->code($res->code);

    $c->res->headers($res->headers);

    $c->render(data => $body_part);

  }

});

get '/' => sub {

  my $c = shift;

  

  $c->reply->static('index.html');

};

app->start;