~woffs/wcm

ref: b96099b341116b8b1f1e7c080a4477b40caa77cc wcm/index.pl -rwxr-xr-x 6.0 KiB
b96099b3 — Frank Doepper fix safari urlencoding 10 years ago
                                                                                
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
#!/usr/bin/perl -Tw
#
# WofFS' Content Machine
# http://woffs.de/WCM
# <wcm@woffs.de>
#
# Version 20120408
# 
# © WofFS 2010
# License: CC-BY-SA 3.0
# http://creativecommons.org/licenses/by-sa/3.0/
#
use strict;
use utf8;
eval "use Text::Markdown";

### config here ###

my $src='src';                 # source dir tree
my $template='template.html';  # HTML template
my $menulevel=1;               # how many menulevels to show

### that's it! below is for advanced users ###

### SUB ###

my $fourzerofour='page not found';
my $content=$fourzerofour;     # content fill-in
my $current='';                # selected page
my $lm=0;                      # last modified
my $redir='';                  # redirect?
my $fallback;                  # if matching page found elsewhere
my $bcurrent;                  # basename of selected page
my $abs;                       # absolute path
my $pagetitle='';              # title for HTML

sub walktree ($$$);            # prototype needed because of recursion

sub walktree ($$$) {
  my $dir=shift;
  my $indent=shift;
  my $hiddendir=shift;
  opendir (my $dh,$dir) or return '';
  my $lnavi='';
  my $hit;
  foreach my $file (sort readdir ($dh)) {
    next if $file=~/^\./;                  # skip special directories and hidden files
    next if $file=~/\.sw[po]$/;            # skip vim swap files
    next if $file=~/~$/;                   # skip vim backup files
    (my $title=$file)=~s/\.[a-z]+$//;      # strip extension
    $title=~s/^[^_]*_//;                   # strip until first _ for sorting
    my $hidden=($&=~/^0/);                 # 00_ 01_ etc. means hidden
    (my $href="$dir/$title")=~s,^$src/,,;  # strip subdir name
    $href=~s/(^|\/)[^_]*_/$1/g;            # strip until first _ in all path components
    $href=~s/[ ?'"&;]/_/g;                 # replace special chars in links
    my $selected='';                       # highlight selected link
    (my $bhref=$href)=~s,.*/,,;
    $fallback=$href if lc $bhref eq lc $bcurrent;

    #
    # look for $content
    #
    if ($current eq $href                  # current file is selected file, or
        or "$current/index" eq $href                 # directory index
        or ($current eq '' and $href eq 'index')) {  # root directory index
      $selected=' class="selected"';
      $pagetitle=" - $title" unless $title eq 'index';
      if (-f "$dir/$file") {
        #
        # *.pl, *.sh, *.bash, *.cgi, *.php, *.mphp: system()
        # other: just slurp in
        #
        my $untaint=$& if "$dir/$file" =~ /^.*$/;
        if ($file=~/\.sh$/) {
          $content=`sh \"$untaint\"`;
        } elsif ($file=~/\.bash$/) {
          $content=`bash \"$untaint\"`;
        } elsif ($file=~/\.m?php$/) {
          $content=`php \"$untaint\"`;
        } elsif ($file=~/\.pl$/) {
          $content=`perl -Tw \"$untaint\"`;
        } elsif ($file=~/\.cgi$/) {
          $content=`\"$untaint\"`;
        } elsif (open C,'<',$untaint) {
          $content=join('',<C>);
          close C;
          $lm=(stat(_))[9];
        }

        #
        # postprocess $content with markdown
        #
        eval {
          $content=Text::Markdown::Markdown($content)
        } unless $file=~/\.(?:html|php)$/;
        $content="<b>ERROR</b>: <a href=\"http://daringfireball.net/projects/markdown/\">Text::Markdown</a> perl module not found".
                 "<br/>Please install. Showing plain page:<br/><pre>$content</pre>\n" if $@;
        $hit=1;
      } elsif (-l "$dir/$file") {
        $redir=readlink "$dir/$file";
      }
    }

    #
    # fill $navi
    #
    unless ($hidden or $hiddendir) {
      $lnavi.=" "." "x$indent."<li class=\"indent$indent\">"
            ."<a$selected href=\"$abs$href\">$title</a>";
    }
    my $submenu=walktree("$dir/$file",($indent+1),($hidden or $hiddendir)) if -d "$dir/$file";
    if ($submenu) {
      $hit=1;
      $lnavi.=$submenu;
    }
    $lnavi.="</li>\n" unless $hidden or $hiddendir;
  }
  closedir $dh;
  # nice indentation in HTML source
  $lnavi="\n"." "x$indent."<ul>\n".$lnavi." "x$indent."</ul>" if $lnavi;
  return ($hit or $indent <= $menulevel) ? $lnavi : undef;
}

### BEGIN ###

# untaint
$ENV{'PATH'}='/bin:/usr/bin';
delete @ENV{'IFS','CDPATH','ENV','BASH_ENV'};

# kill script if it does not terminate after 3 minutes
use sigtrap qw/die ALRM/;
alarm 180; # max. seconds

# which page requested
$current=$1 if $ENV{'QUERY_STRING'} and $ENV{'QUERY_STRING'}=~/^page=([^&]*)(&.*)?$/;
my $clen=$2?length($2):0;
$clen+=length($current);
$current=~s/%([0-9A-F]{2})/sprintf("%c",hex($1))/gei; # urldecode
$current=~s,/*$,,;                         # strip trailing /
($bcurrent=$current)=~s,.*/,,;

# build absolute URI
my $host=$ENV{'HTTP_HOST'} || $ENV{'SERVER_NAME'} || 'localhost';
my $https=$ENV{'HTTPS'} || 'off';
my $port=$ENV{'SERVER_PORT'} || 80;
$host=~s/:.*$//; # fnord
$abs='http'.($https eq 'on' ? 's' : '').
        "://$host".($port == ($https eq 'on' ? 443 : 80) ? '' : ":$port");
if (my $ru=$ENV{REQUEST_URI}) {
  $ru=~s/%([0-9A-F]{2})/sprintf("%c",hex($1))/gei; # urldecode
  $abs.=substr($ru,0,length($ru)-$clen);
} else {
  $abs.=$ENV{'SCRIPT_NAME'} || '/index.pl';
}
(my $prefix=$abs)=~s,[^/]*$,,;
$abs.='?page=' if $abs =~ /index\.pl$/;
$abs.='page=' if $abs =~ /index\.pl\?$/;

# traverse directories and fill $navi and $content
my $navi=walktree($src,0,0);

# spit it out
if ($redir) {
  $redir=~s,^/,,;
  print 'Location: '.($redir=~/^http/ ? '' : $abs)."$redir\n\n";
} else {
  print "Content-Type: text/html; charset=utf-8\n";
  if ($content eq $fourzerofour) {
    if ($fallback) {
      $fallback=~s,^/,,;
      print "Location: $abs$fallback\n";
    } else {
      print "Status: 404 Not Found\n";
    }
  } elsif ($lm) {
    my @t=split(/\s+/,gmtime($lm));
    printf "Last-Modified: %s, %02d %s %04d %s GMT\n",$t[0],$t[2],$t[1],$t[4],$t[3];
  }
  print "\n";

  $content=~s/__prefix__/$prefix/g;
  $content=~s/__pprefix__/$abs/g;
  open T,"< $template" or die $!;
  while (<T>) {
    s/__navi__/$navi/g;
    s/__title__/$pagetitle/g;
    s/__content__/$content/g;
    s/__prefix__/$prefix/g;
    s/__pprefix__/$abs/g;
    print;
  }
  close T;
}

### END ###