Semece.psgi.orig

   1 #!/usr/bin/env perl
   2 #
   3 # Copyright (c) 2010 Abel Abraham Camarillo Ojeda <acamari@verlet.org>
   4 #
   5 # Permission to use, copy, modify, and distribute this software for any
   6 # purpose with or without fee is hereby granted, provided that the above
   7 # copyright notice and this permission notice appear in all copies.
   8 #
   9 # THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
  10 # WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
  11 # MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
  12 # ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
  13 # WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
  14 # ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
  15 # OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
  16 #
  17
  18 # PSGI entry point and configuration file.
  19 # Please copy this file as 'Semece.psgi', and edit it!.
  20
  21 my $semece      = undef;
  22 my $conf        = undef;
  23
  24 sub setconf;
  25 sub grow_inc;
  26
  27 ######################
  28 # USER CONFIGURATION #
  29 ######################
  30 sub setconf {
  31 # About filesystem paths.
  32 $conf = {
  33         # Absolute filesystem path to the current dir. (No default value)
  34         srcd            => "",
  35         # Absolute filesystem path to the data dir. (No default value)
  36         postd           => "",
  37         # Absolute filesystem path to the user dir. (Default: /home/)
  38         userd           => '/home/'
  39 };
  40
  41 # About content.
  42 $conf = { %$conf,
  43         # Suffix for markdown files (default: ".mkd")
  44         mkd_sufx        => ".mkd",
  45         # Index file: file to parse when a user request the parent directory.
  46         # (default: "index.mkd")
  47         mkd_idx         => "index.mkd",
  48         #  Markdown content type: default content-type for markdown.
  49         mkd_ct          => "text/plain; charset=UTF-8;",
  50         # Content-Type for plain text: Content-Type header to show when we are
  51         # returning plain text to the user. (default: "text/plain;
  52         # charset=UTF-8")
  53         plain_ct        => "text/plain; charset=UTF-8;",
  54         # Content-Type for HTML: Content-Type header to show when we are
  55         # returning HTML to the user. (default: "text/html; charset=UTF-8")
  56         html_ct         => "text/html; charset=UTF-8;",
  57         # Fallback Content-Type: when I cannot determine which one to use.
  58         fb_ct           => "application/octect-stream",
  59 };
  60
  61 # URI to filesystem resolution "table"; this _must_ be an array ref. We travel
  62 # this array using it as a hash (getting a key and value pair (so this array ref
  63 # _must_ have an even number of elements)). First, we match an URI against the
  64 # "key" of this "hash", if it matches, then we look into the hash "value" (which
  65 # must be a true hash ref) for a key named "fs" which declares an anonymous
  66 # subroutine which is run with two arguments: the original URI, and the regex
  67 # that matched it. You are free to implement your URI to filesystem translation
  68 # however you like (but be sure to not insert any '..', or any other insecure
  69 # shit).
  70 $conf->{uri2fs}         = [
  71                 qr!^/static$|^/static/! => {
  72                         name    => "static",
  73                         fs      => sub {
  74                                 my ($uri, $regex) = @_;
  75                                 return $conf->{srcd}. $uri;
  76                         }
  77                 },
  78                 qr!^/~([[:alnum:]_]+)!  => {
  79                         name    => "userdir",
  80                         fs      => sub {
  81                                 my ($uri, $regex) = @_;
  82                                 my ($user) = $uri =~ $regex;
  83                                 die "\$user mustn't be undef!, stopped"
  84                                     unless $user;
  85                                 $uri =~ s/$regex//;
  86                                 return $conf->{userd}. "/". $user.
  87                                        "/".  "public_html/".  $uri;
  88                         }
  89                 },
  90                 qr!^/.*$!       => {
  91                         name    => "postd",
  92                         fs      => sub {
  93                                 my ($uri, $regex) = @_;
  94                                 return $conf->{postd}. "/". $uri;
  95                         }
  96                 },
  97 ];
  98
  99 $conf;
 100 }
 101
 102 ##############
 103 # DON'T EDIT #
 104 ##############
 105 sub checkconf {
 106         my $conf = shift;
 107         if (not defined($conf->{srcd})) {
 108                 die "ERROR: \$conf->{srcd} mustn't be undef!, stopped";
 109         } elsif (not $conf->{srcd}) {
 110                 die "ERROR: \$conf->{srcd} mustn't be empty!, stopped";
 111         }
 112         return $conf;
 113 }
 114
 115
 116 # Adds $conf->{srcd} to the search path for libraries, this must be done at
 117 # compiling time.
 118 sub grow_inc {unshift(@INC, $conf->{srcd}. "/lib")}
 119 BEGIN {$conf = checkconf(setconf()); grow_inc();}
 120
 121 # PSGI entry point.
 122 $semece = sub {
 123         my $env         = shift;
 124
 125         # XXX: The $conf set in the BEGIN is lost for unknown reasons...
 126         $conf = setconf();
 127
 128         use Semece;
 129         $env->{"semece.conf"} = $conf;
 130         return &Semece::serv($env);
 131 }
 132