Rewrote index.cgi to use TUWF

I initially didn't use TUWF (or YAWF, as it was still called back then)
because I considered it a too annoying-to-install dependency and I
wanted this pastebin to be easily installable for other people as well.
However, now that TUWF is a proper project with proper documentation, I
see no problems with using it anymore.

The current code is still based quite a bit on the old CGI code, so it
doesn't look all that nice. But at least I don't have to write plain
HTML anymore.

Also fixed the "needsupdate" column being ignored bug, and added
"noindex" HTML meta tags.

1 files changed, 319 insertions, 226 deletions

diff --git a/index.cgi b/index.cgi
index 7bd4759..f93d2e8 100755
--- a/index.cgi
+++ b/index.cgi
@@ -15,296 +15,389 @@
 #   passcode varchar
 # );
 
-# ALTER TABLE pastes ADD COLUMN passcode varchar;
+# Converting from older schemas:
 # 2010-12-23:
 #  ALTER TABLE pastes DROP COLUMN ip;
 
+# This isn't the cleanest code I've ever written...
 
 use strict;
 use warnings;
-use CGI::Minimal;
-use CGI::Carp 'fatalsToBrowser';
-use DBI;
-use Encode 'decode_utf8', 'encode_utf8';
+use TUWF ':html', 'html_escape';
 
-#$SIG{__WARN__} = sub { die $_[0] };
-$ENV{LANG} = 'en_US.UTF-8';
-
-my $db = DBI->connect(undef, undef, undef, { RaiseError => 1, pg_enable_utf8 => 1 });
 
 my @syntax = map /([^\/]+)\.vim$/?$1:(),
   glob("/usr/share/vim/vim72/syntax/*.vim"),
   glob("/usr/share/vim/vim73/syntax/*.vim");
 
-my $cgi = CGI::Minimal->new();
-msg('Too large POST data. Make sure your paste does not exceed 1MiB.', 'backform') if $cgi->truncated;
-
-
-my $q = $ENV{QUERY_STRING} || '';
-my $ispost = ($ENV{REQUEST_METHOD}||'') =~ /post/i;
-plain("User-agent: *\nDisallow: /\n") if $q eq 'robots.txt';
-mypastes() if $q eq 'mypastes';
-unpaste($1) if $q =~ /^([a-z0-9]+)$/ && $ispost;
-view($1) if $q =~ /^([a-z0-9]+)$/;
-raw($1) if $q =~ /^([a-z0-9]+)\.txt$/;
-upload() if !$q && $ispost;
-form() if !$q;
-msg('Holy cow! This page does not seem to exist.');
-
-
-sub header {
-  printf "Content-Type: %s; charset=UTF-8\n", shift;
-  print $_ for @_;
-  if(($ENV{HTTP_ACCEPT_ENCODING}||'') =~ /gzip/) {
-    print "Content-Encoding: gzip\n\n";
-    binmode STDOUT, ':gzip';
-  } else {
-    print "\n";
+
+TUWF::set(
+  logfile       => $ENV{TUWF_LOG},
+  max_post_body => 1024*1024, # 1MiB
+  # let DBI figure out the login details from the DBI_ environment variables
+  db_login      => [undef, undef, undef],
+);
+TUWF::register(
+  qr//                   => \&home,
+  qr/mypastes/           => \&mypastes,
+  qr/([a-z0-9]{5})\.txt/ => \&raw,
+  qr/([a-z0-9]{5})/      => \&paste,
+);
+TUWF::run();
+
+
+
+sub home {
+  my $self = shift;
+
+  # upload form
+  if($self->reqMethod() ne 'POST') {
+    $self->htmlHeader('mypastes');
+    $self->htmlUploadForm;
+    $self->htmlFooter;
+    return;
   }
-  binmode STDOUT, ':utf8';
+
+  # handle upload
+  my @chars = ('0'..'9', 'a'..'z');
+  my $code = join '', map $chars[rand @chars], 1..5;
+
+  # create redirect response first, so that any Set-Cookie headers aren't forgotten
+  # msg() calls resInit() anyway
+  $self->resRedirect("/$code", 'post');
+
+  my $f = $self->formValidate(
+    { post => 's', required => 0, default => 'nosyntax', enum => \@syntax },
+    { post => 'w', required => 0, default => 0 },
+    { post => 'c', required => 0, default => 0 },
+  );
+
+  return $self->msg('Unknown syntax code', 'backform') if $f->{_err} && grep $_->[0] eq 's', @{$f->{_err}};
+  my $p = $self->passcode('p', 'ps');
+  return if !defined $p;
+
+  require Encode;
+  my $dat = Encode::encode_utf8($self->reqPost('f')||'') || $self->reqUploadRaw('u') || '';
+  $dat =~ s/\x0D\x0A?/\n/g;
+  return $self->msg("Only UTF-8 encoded data is allowed!\nMake sure you're not uploading a binary file.", 'backform')
+    if !eval { $dat = Encode::decode_utf8($dat, 1); 1; };
+  return $self->msg("You don't have much to paste, do you?", 'backform')
+    if $dat =~ /^[ \n\s\t]*$/s && $f->{s} ne 'whitespace';
+
+  my $html = $f->{s} eq 'nosyntax' ? undef : _get_html({ raw => $dat, syntax => $f->{s}, parse_urls => $f->{c}});
+  $self->dbExec(
+    'INSERT INTO pastes (code, syntax, wrap, raw, html, parse_urls, passcode) VALUES(!l)',
+    [ $code, $f->{s}, $f->{w}, $dat, $html, $f->{c}, $p || undef]
+  );
 }
 
 
-sub plain {
-  header('text/plain');
-  print @_;
-  exit;
+sub mypastes {
+  my $self = shift;
+  my $p = $self->passcode('pc','psp');
+
+  my $pl = $self->dbAll(q|
+    SELECT code, to_char(date, 'YYYY-MM-DD HH24:MI:SS') AS date, syntax,
+           substring(raw from 1 for 150) AS preview, length(raw) AS size
+      FROM pastes
+     WHERE passcode = ?
+     ORDER BY date DESC|,
+     $p
+  );
+  return $self->msg('No pastes with that passcode!') if !@$pl;
+
+  $self->htmlHeader('mypastes', 'newpaste');
+  Tr;
+   td class => 'ff', ' ';
+   td class => 'top';
+    b 'Listing all your pastes:';
+    table class => 'mypastelist';
+     for(@$pl) {
+       Tr;
+        td class => 'mpldate', $_->{date};
+        td class => 'mplcode'; a href => "/$_->{code}", $_->{code}; end;
+        td class => 'mplsyn',  $_->{syntax};
+        td class => 'mplsize', sprintf '%.1fk', $_->{size}/1024;
+        td class => 'mplprev', $_->{preview};
+       end;
+     }
+    end;
+   end;
+  end 'tr';
+  $self->htmlFooter;
 }
 
 
-sub msg {
-  my $end = $_[1] ? '<br /><a href="javascript:history.go(-1)">Back to the form</a>.' : '';
-  html('mypastes', 'newpaste', qq|<tr><td class="numbers">&nbsp;</td><td class="top"><br />$_[0]$end</td></tr>|);
-  exit;
+sub raw {
+  my($self, $code) = @_;
+  my $r = $self->getpaste($code, 'raw');
+  return if !ref $r;
+  $self->resHeader('Content-Type' => 'text/plain; charset=UTF-8');
+  lit $r->{raw};
 }
 
 
-sub escape {
-  local $_ = shift;
-  return '' if !$_ && $_ ne '0';
-  s/&/&amp;/g;
-  s/</&lt;/g;
-  s/>/&gt;/g;
-  s/"/&quot;/g;
-  s/\r?\n/<br \/>/g if !$_[0];
-  return $_;
+sub paste {
+  my($self, $code) = @_;
+
+  # unpaste
+  if($self->reqMethod eq 'POST') {
+    my $r = $self->getpaste($code, 'passcode');
+    return if !ref($r);
+    return $self->msg('Incorrect passcode!')
+      if !$r->{passcode} || !$self->reqPost('pc') || $r->{passcode} ne $self->reqPost('pc');
+    $self->dbExec('DELETE FROM pastes WHERE code = ?', $code);
+    return $self->msg("Unpasted!");
+  }
+
+  # view
+  my $r = $self->getpaste($code, 'wrap, raw, html, parse_urls, syntax');
+  return if !ref($r);
+
+  my $cnt = ($r->{raw} =~ y/\n/\n/);
+  $cnt += 1 if $r->{raw} !~ /\n$/;
+
+  $self->htmlHeader(\$code, 'mypastes', 'newpaste');
+  Tr;
+   td class => 'numbers';
+    if(!$r->{wrap}) {
+      pre;
+       for (1..$cnt) {
+         a name => "r$_", href => "#r$_", $_;
+         lit "\n";
+       }
+      end;
+    }
+   end;
+   td class => 'top code';
+    pre $r->{wrap} ? (class => 'allowwrap') : ();
+     lit _get_html($r);
+    end;
+   end;
+  end 'tr';
+  $self->htmlFooter;
 }
 
 
-sub escape_url {
+
+# utility functions
+
+sub _escape_url {
   my $str = shift;
   my $r = '';
   my $last = 0;
   while($str =~ m{((?:https?|ftp)://[^ ><"\n\s]+[\d\w=/-])}g) {
-    $r .= sprintf '%s<a href="%s">%2$s</a>', escape(substr $str, $last, (pos($str)-length($1))-$last), escape($1);
+    $r .= sprintf '%s<a href="%s">%2$s</a>', html_escape(substr $str, $last, (pos($str)-length($1))-$last), html_escape($1);
     $last = pos $str;
   }
-  return $r.escape(substr $str, $last);
+  return $r.html_escape(substr $str, $last);
 }
 
 
-sub get_html {
+sub _get_html {
   my $p = shift;
   return $p->{html} if $p->{html};
-  my $e = $p->{parse_urls} ? \&escape_url : \&escape;
+  my $e = $p->{parse_urls} ? \&_escape_url : \&html_escape;
   return $e->($p->{raw}) if $p->{syntax} eq 'nosyntax';
 
+  $ENV{LANG} = 'en_US.UTF-8';
   require Text::VimColor;
-  my $m = Text::VimColor->new(string => encode_utf8($p->{raw}), filetype => $p->{syntax})->marked();
+  require Encode;
+
+  my $m = Text::VimColor->new(string => Encode::encode_utf8($p->{raw}), filetype => $p->{syntax})->marked();
   my $html = '';
   foreach (@$m) {
-    my $t = $e->(decode_utf8($_->[1]));
+    my $t = $e->(Encode::decode_utf8($_->[1]));
     $html .= $_->[0] eq '' ? $t : qq|<span class="syn$_->[0]">$t</span>|;
   }
   return $html;
 }
 
 
-sub passcode {
-  my ($p, $ps) = @_;
-  $p = $cgi->param($p);
-  $ps = $cgi->param($ps);
-  msg("Oops! I couldn't handle your passcode. It is either too long, or it contains characters I can not handle.", 'backform')
-    if length($p) > 64 or $p && $p !~ /^[a-zA-Z0-9-_\.]+$/;
-  my $cookie = !$p || !$ps ? '' : qq|Set-Cookie: secret_passcode=$p; path=/; expires=Wed, 07-Oct-2020 18:06:05 GMT\n|;
-  return ($p, $cookie);
-}
-
-
-sub upload {
-  my @chars = ('0'..'9', 'a'..'z');
-  my $code = join '', map $chars[rand @chars], 1..5;
-  my $s = $cgi->param('s') || 'nosyntax';
-  my $w = $cgi->param('w') ? 1 : 0;
-  my $c = $cgi->param('c') ? 1 : 0;
-  my ($p, $cookie) = passcode('p', 'ps');
-  msg('Unknown syntax code.', 'backform') if !grep $s eq $_, @syntax;
-  my $dat = $cgi->param('u') || $cgi->param('f') || '';
-  $dat =~ s/\x0D\x0A?/\n/g;
-  msg("Only UTF-8 encoded data is allowed!\nMake sure you're not uploading a binary file.", 'backform')
-    if !eval { $dat = decode_utf8($dat, 1); 1; };
-  msg("You don't have much to paste, do you?", 'backform') if $dat =~ /^[ \n\s\t]*$/s && $s ne 'whitespace';
-
-  my $html = $s eq 'nosyntax' ? undef : get_html({ raw => $dat, syntax => $s, parse_urls => $c});
-  $db->do('INSERT INTO pastes (code, syntax, wrap, raw, html, parse_urls, passcode) VALUES(?,?,?,?,?,?,?)',
-    undef, $code, $s, $w, $dat, $html, $c, $p || undef);
-
-  print "Status: 303\n${cookie}Location: http://$ENV{HTTP_HOST}/$code\nContent-type: text/plain\n\nRedirecting...\n";
-  exit;
-}
 
 
-sub get {
-  my($code, $col) = @_;
-  my $q = $db->prepare(qq{
-    SELECT 1 AS exists, $col, (lastvisit < (NOW()-'1 day'::interval)) AS needsupdate
-      FROM pastes WHERE code = ?
-  });
-  $q->execute($code);
-  my $r = $q->fetchrow_hashref();
-  msg('No paste with that code.') if !$r->{'exists'};
-  $db->do('UPDATE pastes SET lastvisit = NOW() WHERE code = ?', undef, $code);
-  return $r;
+# object methods
+
+package TUWF::Object;
+
+use TUWF ':html', 'html_escape';
+
+
+sub htmlHeader {
+  my($self, @links) = @_;
+  html lang => 'en';
+  head;
+   title 'Blicky.net nopaste';
+   Link rel => 'stylesheet', type => 'text/css', href => '/style.css';
+   meta name => 'robots', content => 'noindex, nofollow', undef;
+  end;
+  body;
+   div id => 'leftdiv', '';
+   div id => 'toplinks';
+    for(@links) {
+      txt ' ';
+      if(ref($_)) {
+        a href => '#', onclick => "return unpaste('/$$_')", 'unpaste';
+        txt ' ';
+        a href => "/$$_.txt", 'raw';
+      } else {
+        /newpaste/ && a href => '/', 'new paste';
+        /mypastes/ && a href => '#', onclick => 'return mypastes()', 'my pastes';
+      }
+    }
+   end;
+   table;
+    Tr; td colspan => 2, class => 'header';
+     h1 'Blicky.net nopaste';
+    end; end;
 }
 
 
-sub view {
-  my $code = shift;
-  my $r = get $code, 'wrap, raw, html, parse_urls, syntax';
-
-  my $cnt = ($r->{raw} =~ y/\n/\n/);
-  $cnt += 1 if $r->{raw} !~ /\n$/;
-  my $html = get_html($r);
-  html(
-    qq{<a href="#" onclick="return unpaste('/$code')">unpaste</a>},
-    qq{<a href="/$code.txt">raw</a>},
-    'mypastes', 'newpaste',
-    sprintf q|<tr><td class="numbers"><pre>%s</pre></td><td class="top code"><pre%s>%s</pre></td></tr>|,
-      $r->{wrap} ? '' : join("\n", map qq|<a name="r$_" href="#r$_">$_</a>|, 1..$cnt),
-      $r->{wrap} ? ' class="allowwrap"' : '',
-      $html
-  );
-  exit;
+sub htmlFooter {
+    end 'table';
+    script type => 'text/javascript', src => '/script.js', '';
+   end 'body';
+  end 'html';
 }
 
 
-sub raw {
-  my $code = shift;
-  my $r = get $code, 'raw';
-  plain($r->{raw});
-}
-
-
-sub unpaste {
-  my $code = shift;
-  my $r = get $code, 'passcode';
-  msg("Incorrect passcode!") if !$r->{passcode} || !$cgi->param('pc') || $r->{passcode} ne $cgi->param('pc');
-  $db->do('DELETE FROM pastes WHERE code = ?', undef, $code);
-  msg("Unpasted!");
+sub htmlUploadForm {
+  my $self = shift;
+  use utf8;
+  Tr;
+   td class => 'ff', '';
+   td class => 'top';
+    form enctype => 'multipart/form-data', 'accept-charset' => 'utf-8', method => 'post', action => '/';
+
+     fieldset;
+      legend '▾ Contents';
+      textarea name => 'f', id => 'f', '';
+      br;
+      input type => 'submit', value => 'Submit', id => 'submit';
+      txt '-or- ';
+      input type => 'file', name => 'u', id => 'u';
+      i ' (UTF-8, max. ~1MiB)';
+     end;
+
+     fieldset;
+      legend '▾ Formatting';
+      a href => '#', id => 'formatsave', 'save as default';
+      input type => 'checkbox', class => 'check', id => 'w', name => 'w', value => 1;
+      label for => 'w', ' allow line wrapping';
+      br;
+      input type => 'checkbox', class => 'check', id => 'c', name => 'c', value => 1, checked => 'checked';
+      label for => 'c', ' make URLs clickable';
+      br;
+      i 'Syntax highlighting: ';
+      input type => 'text', name => 's', id => 's', size => 10, value => 'nosyntax';
+      i;
+       txt ' Popular: ';
+       b class => 'syntax';
+        for (@{$self->dbAll('SELECT syntax FROM pastes GROUP BY syntax ORDER BY count(*) DESC LIMIT 7')}) {
+          a href => '#', onclick => 'return setsyn(this)', $_->{syntax};
+          txt ' ';
+        }
+       end;
+       txt '| ';
+       a href => '#', onclick => 'return showall()', 'Show all »';
+      end 'i';
+      div id => 'syntax', style => 'display: none';
+       for (@syntax) {
+         a href => '#', onclick => 'return setsyn(this)', $_;
+         txt ' ';
+       }
+      end;
+     end 'fieldset';
+
+     fieldset;
+      legend '▾ Passcode';
+      label for => 'p', 'Passcode: ';
+      input type => 'password', name => 'p', id => 'p', size => 10;
+      input type => 'checkbox', class => 'check', id => 'ps', name => 'ps', value => 1;
+      label for => 'ps', ' save on my computer';
+      br;
+      i;
+       txt '(Optional, necessary for listing and/or removing your pastes.)';
+       br;
+       b 'Important:';
+       txt ' make sure your passcode is not something other people are likely to use.'
+          .' For example, use "nickname-asdf" instead of "asdf".';
+      end;
+     end 'fieldset';
+    end 'form';
+
+    fieldset;
+     legend '▾';
+     ul;
+      li "Pastes don't expire.";
+      li 'All pastes are private, that is, nobody can find your paste unless they know the URL or the passcode.';
+      li;
+       txt 'If you absolutely need to have a paste removed from this site, and you lost your passcode, send a mail to ';
+       a href => 'mailto:ayo@blicky.net', 'ayo@blicky.net';
+       txt '.';
+      end;
+      li;
+       txt 'Want to paste stuff from the commandline? We have a ';
+       a href => '/bpaste.pl', 'script';
+       txt ' for that.';
+      end;
+      li 'Code highlighting is provided by vim.';
+     end;
+    end 'fieldset';
+
+   end 'td';
+  end 'tr';
 }
 
 
-sub form {
-  my $q = $db->prepare('SELECT syntax FROM pastes GROUP BY syntax ORDER BY count(*) DESC LIMIT 7');
-  $q->execute();
-  my @l = map qq|<a href="#" onclick="return setsyn(this)">$_->{syntax}</a>|, @{$q->fetchall_arrayref({})};
-
-  my @syn = map qq|<a href="#" onclick="return setsyn(this)">$_</a>|, @syntax;
-  use utf8;
-  html('mypastes',
-  sprintf <<'__', join(' ', @l), join(' ', @syn));
-  <tr><td class="ff">&nbsp;</td><td class="top">
-   <form enctype="multipart/form-data" accept-charset="utf-8" method="post" action="/">
-    <fieldset>
-     <legend>▾ Contents</legend>
-     <textarea name="f" id="f"></textarea><br />
-     <input type="submit" value="Submit" id="submit" />
-     -or- <input type="file" name="u" id="u" /> <i>(UTF-8, max. ~1MiB)</i>
-    </fieldset>
-    <fieldset>
-     <legend>▾ Formatting</legend>
-     <a href="#" id="formatsave">save as default</a>
-     <input type="checkbox" class="check" id="w" name="w" value="1" /> <label for="w">allow line wrapping</label><br />
-     <input type="checkbox" class="check" id="c" name="c" value="1" checked="checked" /> <label for="c">make URLs clickable</label><br />
-     <i>Syntax highlighting:</i> <input type="text" name="s" id="s" size="10" value="nosyntax" /> <i>Popular: <b class="syntax">%s</b> | <a href="#" onclick="return showall()">Show all &raquo;</a></i>
-     <div id="syntax" style="display: none">%s</div>
-    </fieldset>
-    <fieldset>
-     <legend>▾ Passcode</legend>
-     <label for="p">Passcode:</label> <input type="password" name="p" id="p" size="10" />
-     <input type="checkbox" class="check" id="ps" name="ps" value="1" /> <label for="ps">save on my computer.</label><br />
-     <i>(Optional, necessary for listing and/or removing your pastes.)<br />
-     <b>Important:</b> make sure your passcode is not something other people are likely to use. For example, use "nickname-asdf" instead of "asdf".</i>
-    </fieldset>
-   </form>
-   <fieldset>
-    <legend>▾</legend>
-    <ul>
-     <li>Pastes don't expire.</li>
-     <li>All pastes are private, that is, nobody can find your paste unless they know the URL or the passcode.</li>
-     <li>If you absolutely need to have a paste removed from this site, and you lost your passcode, send a mail to <a href="mailto:ayo@blicky.net">ayo@blicky.net</a>.</li>
-     <li>Want to paste stuff from the commandline? We have a <a href="/bpaste.pl">script</a> for that.</li>
-     <li>Code highlighting is provided by vim.</li>
-    </ul>
-   </fieldset>
-  </td></tr>
-__
-  exit;
+# fetches a paste and updates lastvisit column when necessary
+sub getpaste {
+  my($self, $code, $col) = @_;
+  my $r = $self->dbRow(q|
+    SELECT !s, (lastvisit < (NOW()-'1 day'::interval)) AS needsupdate
+      FROM pastes WHERE code = ?
+    |, $col, $code
+  );
+  return $self->msg('No paste with that code.') if !keys %$r;
+  $self->dbExec('UPDATE pastes SET lastvisit = NOW() WHERE code = ?', $code) if $r->{needsupdate};
+  return $r;
 }
 
 
-sub mypastes {
-  my ($p, $cookie) = passcode('pc','psp');
-  my $q = $db->prepare(q|
-    SELECT code, to_char(date, 'YYYY-MM-DD HH24:MI:SS') AS date, syntax,
-           substring(raw from 1 for 150) AS preview, length(raw) AS size
-      FROM pastes
-     WHERE passcode = ?
-     ORDER BY date DESC|);
-  $q->execute($p);
-  my $pl = $q->fetchall_arrayref({});
-  msg('No pastes with that passcode!') if !@$pl;
-  html(\$cookie, 'mypastes', 'newpaste', sprintf <<' __',
-  <tr><td class="ff">&nbsp;</td><td class="top">
-  <b>Listing all your pastes:</b>
-  <table class="mypastelist">
-  %s
-  </table>
-  </td></tr>
- __
-  join "\n", map sprintf(
-    '<tr><td class="mpldate">%s</td><td class="mplcode"><a href="/%s">%2$s</a></td><td class="mplsyn">%s</td><td class="mplsize">%.1fk</td><td class="mplprev">%s</td></tr>',
-    $_->{date}, $_->{code}, $_->{syntax}, $_->{size}/1024, escape($_->{preview}, 1)), @$pl);
-  exit;
+# generates a simple message as response
+sub msg {
+  my($self, $msg, $back) = @_;
+  $self->resInit;
+  $self->htmlHeader('mypastes', 'newpaste');
+  Tr;
+   td class => 'numbers', '';
+   td class => 'top';
+    br;
+    lit html_escape $msg;
+    if($back) {
+      br;
+      a href => 'javascript:history.go(-1)', 'Back to the form';
+    }
+   end;
+  end 'tr';
+  $self->htmlFooter;
+  return 1;
 }
 
 
-sub html {
-  my %links = (newpaste=>'<a href="/">new paste</a>', mypastes=>'<a href="#" onclick="return mypastes()">my pastes</a>');
-  my $links = !$#_ ? '' : join ' ', map ref($_) ? () : $links{$_} || $_, @_[0..$#_-1];
-  header('text/html', map ref($_) ? $$_ : (), @_[0..$#_-1]);
-  printf <<'__', $links, $_[$#_];
-<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
-<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
- <head>
-  <title>Blicky.net nopaste</title>
-  <link rel="stylesheet" type="text/css" href="/style.css" />
- </head>
- <body>
-  <div id="leftdiv"></div>
-  <div id="toplinks">
-  %s
-  </div>
-  <table>
-   <tr><td colspan="2" class="header">
-    <h1>Blicky.net nopaste</h1>
-   </td></tr>
-   %s
-  </table>
-  <script type="text/javascript" src="/script.js"></script>
- </body>
-</html>
-__
+# fetch passcode and set cookie when requested
+sub passcode {
+  my($self, $p, $ps) = @_;
+  my $f = $self->formValidate(
+    { param => $p,  required => 0, default => '', maxlength => 64, regex => qr/^[a-zA-Z0-9-_\.]+$/ },
+    { param => $ps, required => 0 },
+  );
+  if($f->{_err}) {
+    $self->msg("Oops! I couldn't handle your passcode. It is either too long, or it contains characters I can not handle.", 'backform');
+    return undef;
+  }
+  $self->resCookie(secret_passcode => $f->{$p}, path => '/', expires => time()+3*365*24*3600) if $f->{$p} && $f->{$ps};
+  return $f->{$p};
 }