tokuhirom's Blog

Pure Perl Sinatraish WAF in One File

Some perl web application tutorial says "First, install WAF from CPAN..., and drink a espresso". heh, It's very painful.

Then, I tried to pack the Sinatra-ish WAF in one file. I use yusukebe's Hitagi.pm for this hack. Hitagi.pm doesn't depend to any XS modules without DBI, LWP, Digest::SHA1, these three modules are most popular, and pre-installed on normal rental servers, It's not big issue.

First, pack the Hitagi.pm and other things to one file by mst's App::FatPacker. fatpack is file packer for scripts, but it is also useful for packing libraries.

#!/bin/sh

#
# fastpack - a simple App::FatPacker helper
#

fatpack trace -Ilib -e 'use Hitagi; use Try::Tiny;use Devel::StackTrace;use Devel::StackTrace::AsHTML;'

# optional things: Sub::Name
egrep -v '^(File/Spec.pm|File/Spec/Unix.pm|Scalar/Util.pm|List/Util.pm|Sub/Name.pm|IO.pm|IO/Seekable.pm|IO/Handle.pm|Data/Dumper.pm|Cwd.pm|IO/File.pm|Storable.pm)$' fatpacker.trace | \
    egrep -v '^(Digest/SHA1.pm|Log/Agent.pm|Log/Agent/Priorities.pm|Log/Agent/Formatting.pm|Log/Agent/Message.pm)$' | \
    egrep -v '^(DB/Schema.pm)$' | \
    # require these modules on the server
    egrep -v '^(DBI.pm|auto/DBI/DESTROY.al|HTTP/Message.pm)$' > fatpacker.trace2

PERL5LIB=lib:$PERL5LIB fatpack packlists-for `cat fatpacker.trace2` > fatpacker.packlists
fatpack tree `cat fatpacker.packlists`
[ -d lib ] || mkdir lib

fatpack file > hitagi.pl
echo "1;" >> hitagi.pl

Then, you got a hitagi.pl, it contains Plack, Try::Tiny, Text::MicroTemplate, DBIx::Skinny, etc...
You can use the Hitagi.pm in one file!

BEGIN { do 'hitagi.pl' or die $@; } # <== THIS IS A MOST IMPORTANT!
use Hitagi;

set db => {
    connect_info => [ "dbi:SQLite:dbname=/tmp/nopaste.$<.sqlite",'', '' ],
    schema       => qq{
        install_table entry => schema {
           pk 'id';
           columns qw/id body/;
        };
    }
};

db->do(q{CREATE TABLE IF NOT EXISTS entry ( id varchar, body text )});

get '/' => 'index';

post '/post' => sub {
    my $req  =  shift;
    my $body  = $req->param('body') or redirect( $req->base );
    my $uuid = sub {
        my $x = shift;
        my @seed = ( "a" .. "z", "A" .. "Z", "0" .. "9" );
        join( "", map { $seed[ int rand(@seed) ] } 1 .. $x );
    }->(16);
    my $row = db->insert(
        entry => {
            id   => $uuid,
            body => $body,
        }
    );
    return redirect( $req->base . "entry/$uuid" );
};

get '/entry/{entry_id}' => sub {
    my ( $req, $args ) = @_;
    my $entry_id = $args->{entry_id};
    my $entry = db->single( entry => { id => $entry_id, } );
    return res(404,[],'Not Found!')->finalize unless $entry;
    render( 'entry', { body => $entry->body } );
};

star;

__DATA__

@@ index
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
<html>
<head>
  <title>nopaste</title>
  <link rel="stylesheet" type="text/css" href="<?= $base ?>static/screen.css" />
</head>
<body>
<div class="container">
    <h1><a href="<?= $base ?>">Yet Another nopaste</a></h1>
    <form action="<?= $base ?>post" method="post">
    <p><textarea name="body" cols="60" rows="10"></textarea></p>
    <p><input type="submit" value="no paste" /><p>
    </form>
</div>
</body>
</html>

@@ entry
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
<html>
<head>
  <title>nopaste</title>
  <link rel="stylesheet" type="text/css" href="<?= $base ?>static/screen.css" />
</head>
<body>
<div class="container">
  <h1><a href="<?= $base ?>">Yet Another nopaste</a></h1>
    <pre><?= $body ?></pre>
</div>
</body>
</html>

Then, you can write Perl web application tutorial like

run

% curl http://github.com/tokuhirom/Hitagi/raw/topic/one-file/hitagi.pl -o hitagi.pl

and write

BEGIN { do "hitagi.pl" or die }
use Hitagi;
...

and run

% perl myapp.pl -p 1978
% open http://localhost:1978/

YAY!

This is awesome!

Conclusion

  • pack libraries in one file w/ App::FatPacker is so cool.
  • packed libraries are useful for newbies.