From: Mark Wooding Date: Fri, 3 Jul 2015 19:23:08 +0000 (+0100) Subject: Initial commit. X-Git-Url: https://git.distorted.org.uk/~mdw/odin-cgi/commitdiff_plain/be24e9afafe0d740652d962fd5531de901a9cd09 Initial commit. Seems to work. Mostly. --- be24e9afafe0d740652d962fd5531de901a9cd09 diff --git a/bin/pastebin.userv b/bin/pastebin.userv new file mode 100755 index 0000000..bc7a914 --- /dev/null +++ b/bin/pastebin.userv @@ -0,0 +1,97 @@ +#! /usr/bin/perl + +use lib "lib"; + +use Odin; +use DBI; +use Encode; +use Encode::Locale; +use Getopt::Std; +use POSIX; + +my $BAD = 0; + +sub bad ($) { + my ($m) = @_; + $BAD = 1; + print STDERR "$Odin::PROG: $m\n"; +} + +Odin::cmdline_who; + +sub read_content () { + my $c = ""; + while (read STDIN, my $buf, 8192) { $c .= $buf; } + return Odin::tidy_pastebin_content decode locale => $c; +} + +my $op = shift(@ARGV) // "help"; +if ($op eq "help") { + print <selectall_arrayref + ("SELECT " . Odin::sql_timestamp($db, "stamp") . + ", tag, lang, title + FROM odin_pastebin WHERE owner = ? + ORDER BY stamp", undef, $Odin::WHO)}) { + my ($stamp, $tag, $lang, $title) = @$r; + my $t = strftime "%Y-%m-%d %H:%M:%S %z", localtime $stamp; + printf "%-25s %-12s %-16s %s\n", + $t, $tag, $lang, encode locale => $title; + } +} elsif ($op eq "new") { + my %o; + getopts "l:t:", \%o and @ARGV == 0 + or Odin::fail "usage: new [-l LANG] [-t TITLE]"; + my %p = (title => decode(locale => $o{t}), lang => $o{l} // "plain-text", + content => read_content); + my $db = Odin::open_db; + my $c = ""; + while (read STDIN, my $buf, 8192) { $c .= $buf; } + $p{content} = read_content; + @{$db->selectall_arrayref + ("SELECT lang FROM odin_pastebin_lang WHERE lang = ?", undef, $p{lang})} + or Odin::fail "unknown language `$p{lang}'"; + my ($tag, $edit) = Odin::new_pastebin %p; + print "$Odin::PASTEBIN/$url $edit\n"; +} elsif ($op eq "get") { + @ARGV == 1 or Odin::fail "usage: get TAG"; + my ($tag) = @ARGV; + Odin::get_pastebin Odin::open_db, $tag, my %p; + print encode locale => $p{content}; +} elsif ($op eq "claim") { + @ARGV == 2 or Odin::fail "usage: claim TAG EDITKEY"; + my ($tag, $key) = @ARGV; + Odin::claim_pastebin $tag, $key; +} elsif ($op eq "rekey") { + @ARGV == 1 or Odin::fail "usage: rekey TAG"; + my ($tag) = @ARGV; + my $key = Odin::rekey_pastebin $tag; + print $key, "\n"; +} elsif ($op eq "del") { + @ARGV or Odin::fail "usage: del TAG ..."; + Odin::delete_pastebin map { $_, undef } @ARGV; +} elsif ($op eq "update") { + my %o; + getopts "cl:t:", \%o and @ARGV == 1 + or Odin::fail "usage: update [-c] [-l LANG] [-t TITLE] TAG"; + my ($tag) = @ARGV; + my %p = (title => decode(locale => $o{t}), lang => $o{l}); + if ($o{c}) { $p{content} = read_content; } + Odin::update_pastebin $tag, undef, %p or Odin::fail "nothing changed"; +} else { + Odin::fail "unknown operation `$op'"; +} diff --git a/bin/populate-lang-table b/bin/populate-lang-table new file mode 100755 index 0000000..912aaf6 --- /dev/null +++ b/bin/populate-lang-table @@ -0,0 +1,40 @@ +#! /usr/bin/perl + +use lib "lib"; +use Odin; + +my $db = Odin::open_db; +my %newlang, %oldlang; + +open my $fh, "-|", "highlight", "-p" or die "highlight: $!"; +while (<$fh>) { + my ($descr, $lang) = /^(.*\S)\s*:\s*(\S+)(?:\s.*|)$/; + next unless defined $lang; + $newlang{$lang} = $descr; +} +close $fh or die "close highlight: $! $?"; +$newlang{"txt"} //= "Plain text"; + +Odin::xact { + my $h = $db->selectall_hashref + ("SELECT lang, descr FROM odin_pastebin_lang", "lang"); + for my $k (keys %$h) { $oldlang{$k} = $h->{$k}{descr}; } + for my $lang (keys %oldlang) { + if (!exists $newlang{$lang}) { + print ";; delete stale language `$lang' (`$oldlang{$lang}')\n"; + $db->do("DELETE FROM odin_pastebin_lang WHERE lang = ?", undef, $lang); + } + } + for my $lang (keys %newlang) { + if (!exists $oldlang{$lang}) { + print ";; insert new language `$lang' (`$newlang{$lang}')\n"; + $db->do("INSERT INTO odin_pastebin_lang (lang) VALUES (?)", + undef, $lang); + } elsif ($oldlang{$lang} ne $newlang{$lang}) { + print ";; change description for `$lang' ", + "(`$oldlang{$lang}' -> `$newlang{$lang}')\n"; + $db->do("UPDATE odin_pastebin_lang SET descr = ? WHERE lang = ?", + undef, $newlang{$lang}, $lang); + } + } +} $db; diff --git a/bin/shorturl.userv b/bin/shorturl.userv new file mode 100755 index 0000000..489168d --- /dev/null +++ b/bin/shorturl.userv @@ -0,0 +1,50 @@ +#! /usr/bin/perl + +use lib "lib"; + +use Odin; +use DBI; +use POSIX; + +Odin::cmdline_who; + +my $op = shift(@ARGV) // "help"; +if ($op eq "help") { + print <selectall_arrayref + ("SELECT " . Odin::sql_timestamp($db, "stamp") . ", tag, url + FROM odin_shorturl WHERE owner = ? + ORDER BY stamp", undef, $Odin::WHO)}) { + my ($stamp, $tag, $url) = @$r; + my $t = strftime "%Y-%m-%d %H:%M:%S %z", localtime $stamp; + printf "%-25s %-12s %s\n", $t, $tag, $url; + } +} elsif ($op eq "new") { + @ARGV == 1 or Odin::fail "usage: new URL"; + my ($url) = @ARGV; + my $tag = Odin::new_shorturl $url; + print "$Odin::SHORTURL/$tag\n"; +} elsif ($op eq "get") { + @ARGV >= 0 or Odin::fail "usage: get TAG ..."; + if (@ARGV == 1) { print Odin::get_shorturl $ARGV[0], "\n"; } + else { + for my $tag (@ARGV) + { printf "%-12s %s\n", $tag, Odin::get_shorturl $tag; } + } +} elsif ($op eq "del") { + @ARGV >= 0 or Odin::fail "usage: del TAG ..."; + Odin::delete_shorturl @ARGV; +} else { + Odin::fail "unknown operation `$op'"; +} diff --git a/lib/.gitignore b/lib/.gitignore new file mode 100644 index 0000000..e11a863 --- /dev/null +++ b/lib/.gitignore @@ -0,0 +1 @@ +config.pl diff --git a/lib/Odin.pm b/lib/Odin.pm new file mode 100644 index 0000000..e7786f5 --- /dev/null +++ b/lib/Odin.pm @@ -0,0 +1,436 @@ +### -*-perl-*- + +package Odin; + +use DBI; +use Digest::SHA qw(sha256_hex); +use MIME::Base64; + +###-------------------------------------------------------------------------- +### Early utilities. + +sub merge_hash (\%%) { + my ($hashref, %defaults) = @_; + for my $k (keys %defaults) + { $hashref->{$k} = $defaults{$k} unless exists $hashref->{$k}; } +} + +###-------------------------------------------------------------------------- +### Configuration. + +our $DSN = "dbi:Pg(pg_enable_utf8=>1):host=db"; +our $RETRY = 10; +our @BACKOFF = (0.1, 10, 1.5, 0.5, 2.0); + +our $BASEURL = "http://odin.gg/"; +our $STATIC = "http://odin.gg/"; + +our $SHORTURL_PATH = "u"; +our $PASTEBIN_PATH = "p"; + +our $URLMAXLEN = 1024; +our @URLPAT = ( + qr{^https?://} +); + +our %COOKIE_DEFAULTS = ( + -httponly => undef, + -max_age => 3600 +); + +require "config.pl"; + +our ($SCHEME, $DOMAIN, $BASEPATH) = $BASEURL =~ m!^([^:]+)://([^/]+)(/.*)$!; +merge_hash %COOKIE_DEFAULTS, -domain => $DOMAIN, -path => $BASEPATH; +merge_hash %COOKIE_DEFAULTS, -secure => undef if $SCHEME eq "https"; + +our $SHORTURL = "$BASEURL$SHORTURL_PATH"; +our $PASTEBIN = "$BASEURL$PASTEBIN_PATH"; + +###-------------------------------------------------------------------------- +### Miscellaneous utilities. + +(our $PROG = $0) =~ s:^.*/::; + +sub fail_cmdline ($$%) { + my ($msg, $label, %args) = @_; + print STDERR "$PROG: $msg\n"; + exit 1; +} + +our $FAILPROC = \&fail_cmdline; + +sub fail ($;$%) { + my ($msg, $label, %args) = @_; + $FAILPROC->($msg, $label, %args); +} + +sub set_mason_failproc ($) { + my ($m) = @_; + $FAILPROC = sub { + my ($msg, $label, %args) = @_; + $m->clear_buffer; + $m->comp($label, %args); + $m->abort; + }; +} + +sub nice_name ($) { + my ($s) = @_; + $s =~ s/\W+//g; + return lc $s; +} + +###-------------------------------------------------------------------------- +### Database utilities. + +sub open_db (@) { + my @attr = @_; + my $db = DBI->connect_cached($DSN, undef, undef, { + PrintError => 0, + RaiseError => 1, + @attr + }); + + my $drv = $db->{Driver}{Name}; + if ($drv eq "Pg") { + $db->{private_odin_retry_p} = sub { $db->state =~ /^40[0P]01$/ }; + $db->{private_odin_unixstamp} = sub { "extract(epoch from $_[0])" }; + } elsif ($drv eq "SQLite") { + $db->{private_odin_retry_p} = sub { $db->err == 5 }; + $db->{private_odin_unixstamp} = sub { "strftime('%s', $_[0])" }; + } else { + fail "unsupported database driver `$drv' (patches welcome)", undef; + } + + return $db; +} + +sub xact (&$) { + my ($body, $db) = @_; + my @rv; + my $exc; + + my ($sleep, $maxsleep, $mult, $minvar, $maxvar) = @BACKOFF; + for (my $i = 0; $i < $RETRY; $i++) { + $db->begin_work; + eval { @rv = $body->(); $db->commit; }; + $exc = $@; + return @rv unless $exc; + my $retryp = $db->{private_odin_retry_p}(); + eval { $db->rollback; }; + die $exc unless $retryp; + my $t = $sleep * ($minvar + rand($maxvar - $minvar)); + $sleep *= $mult; $sleep = $max if $sleep > $max; + select undef, undef, undef, $t; + } + die $exc; +} + +sub sql_timestamp ($$) { + my ($db, $col) = @_; + return $db->{private_odin_unixstamp}->($col); +} + +###-------------------------------------------------------------------------- +### Sequence numbers and tagging. + +sub next_seq ($$) { + my ($db, $table) = @_; + my ($seq) = $db->selectrow_array("SELECT seq FROM $table"); + die "no sequence number in $table" unless defined $seq; + $db->do("UPDATE $table SET seq = ?", undef, $seq + 1); + return $seq; +} + +my $ALPHABET = + "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789"; +my $NALPHA = length $ALPHABET; + +sub encode_tag ($) { + my ($seq) = @_; + my $tag = ""; + while ($seq) { + $tag .= substr($ALPHABET, $seq % $NALPHA, 1); + $seq = int $seq/$NALPHA; + } + return $tag; +} + +###-------------------------------------------------------------------------- +### HTTP utilities. + +our %COOKIE; +sub fetch_cookies ($) { + my ($r) = @_; + + %COOKIE = (); + my $cookies = $r->header_in("Cookie"); + if (defined $cookies) { + for my $kv (split /;/, $cookies) { + my ($k, $v) = split /=/, $kv, 2; + $k =~ s/^\s*(|\S|\S.*\S)\s*$/$1/; + $v =~ s/^\s*(|\S|\S.*\S)\s*$/$1/; + $v =~ s/\+/ /g; + $v =~ s/\%([0-9a-f][0-9a-f])/chr hex $1/eg; + $COOKIE{$k} = $v; + } + } +} + +sub bake_cookie ($$%) { + my ($r, $cookie, %attr) = @_; + merge_hash %attr, %COOKIE_DEFAULTS; + my @attr = map { + my $v = $attr{$_}; tr/_-/-/d; + defined $v ? "$_=$v" : $_ + } keys %attr; + $r->headers_out->add("Set-Cookie", join "; ", $cookie, @attr); +} + +sub path_info ($) { + my ($r) = @_; + return $ENV{PATH_INFO} // $r->path_info; +} + +###-------------------------------------------------------------------------- +### HTML utilities. + +sub escapify ($$;$) { + my ($m, $s, $mode) = @_; + return $m->interp->apply_escapes($s, $mode // "h"); +} + +###-------------------------------------------------------------------------- +### Access control. + +our ($WHO, $WHOSURE); +our ($WHOMATCH, $WHOCMP, $WHOPAT); + +sub cgi_who ($) { + my ($r) = @_; + my $raddr = $ENV{REMOTE_ADDR} // $r->connection->remote_ip; + $WHO = ":NET-$raddr"; $WHOSURE = 0; + $WHOMATCH = "LIKE"; $WHOCMP = ":NET-\%"; $WHOPAT = qr/^:NET-/; +} + +sub cmdline_who () { + $WHO = $ENV{USERV_USER} + // ($< == $> && $ENV{USER}) + // @{[getpwuid $<]}[0] + // die "nameless user"; + $WHOMATCH = "="; $WHOCMP = $WHO; $WHOPAT = qr/^\Q$WHO\E$/; + $WHOSURE = 1; +} + +sub new_editkey () { + open my $fh, "/dev/urandom" or die "open urandom: $!"; + sysread $fh, my $rand, 16; + (my $edit = encode_base64 $rand) =~ tr:+/=\n:.-:d; + return $edit, sha256_hex $edit; +} + +###-------------------------------------------------------------------------- +### URL shortening. + +sub get_shorturl ($) { + my ($tag) = @_; + + my $db = open_db; + my ($url) = $db->selectrow_array + ("SELECT url FROM odin_shorturl WHERE tag = ?", undef, $tag); + fail "tag `$tag' not found", ".notfound", tag => $tag unless defined $url; + return $url; +} + +sub valid_url_p ($) { + my ($url) = @_; + return + length $url < $URLMAXLEN && + scalar grep { $url =~ /$_/ } @URLPAT; +} + +sub new_shorturl ($) { + my ($url) = @_; + + valid_url_p $url or fail "invalid url", ".badurl", u => $url; + + my $db = open_db; + my $tag; + xact { + ($tag) = $db->selectrow_array + ("SELECT tag FROM odin_shorturl WHERE owner $WHOMATCH ? AND url = ?", + undef, $WHOCMP, $url); + unless (defined $tag) { + $tag = encode_tag(next_seq($db, "odin_shorturl_seq")); + $db->do("INSERT INTO odin_shorturl (tag, owner, url) VALUES (?, ?, ?)", + undef, $tag, $WHO, $url); + } + } $db; + return $tag; +} + +sub check_shorturl_owner ($$) { + my ($db, $tag) = @_; + + my ($owner) = $db->selectrow_array + ("SELECT owner FROM odin_shorturl WHERE tag = ?", undef, $tag); + fail "tag `$tag' not found", ".notfound", tag => $tag + unless defined $owner; + fail "not owner of `$tag'", ".notowner", tag => $tag + unless $owner =~ /$WHOPAT/; +} + +sub update_shorturl ($$) { + my ($tag, $url) = @_; + + my $db = open_db; + xact { + check_shorturl_owner $db, $tag; + $db->do("UPDATE odin_shorturl SET url = ? WHERE tag = ?", + undef, $url, $tag); + } $db; +} + +sub delete_shorturl (@) { + my (@tags) = @_; + + my $db = open_db; + xact { + for my $tag (@tags) { + check_shorturl_owner $db, $tag; + $db->do("DELETE FROM odin_shorturl WHERE tag = ?", undef, $tag); + } + } $db; +} + +###-------------------------------------------------------------------------- +### Paste bin. + +our %PASTEBIN_DEFAULTS = ( + title => "(untitled)", + lang => "plain-text", + content => "" +); +our @PASTEBIN_PROPS = keys %PASTEBIN_DEFAULTS; +our $PASTEBIN_PROPCOLS = join ", ", @PASTEBIN_PROPS; +our $PASTEBIN_PROPPLACES = join ", ", map "?", @PASTEBIN_PROPS; + +sub new_pastebin (\%) { + my ($new) = @_; + + my $db = open_db; + my ($editkey, $hash) = new_editkey; + my $tag; + + merge_hash %$new, %PASTEBIN_DEFAULTS; + xact { + $tag = encode_tag next_seq $db, "odin_pastebin_seq"; + $db->do("INSERT INTO odin_pastebin + (tag, edithash, owner, $PASTEBIN_PROPCOLS) + VALUES (?, ?, ?, $PASTEBIN_PROPPLACES)", undef, + $tag, $hash, $WHO, @{$new}{@PASTEBIN_PROPS}); + } $db; + return $tag, $editkey; +} + +sub get_pastebin ($$\%) { + my ($db, $tag, $props) = @_; + + (my $owner, my $hash, @{$props}{@PASTEBIN_PROPS}) = + $db->selectrow_array("SELECT owner, edithash, $PASTEBIN_PROPCOLS + FROM odin_pastebin WHERE tag = ?", + undef, $tag); + fail "tag `$tag' not found", ".notfound", tag => $tag + unless defined $owner; + return $owner, $hash; +} + +sub get_pastebin_check_owner ($$\%) { + my ($db, $tag, $props) = @_; + + my ($owner, $hash) = get_pastebin $db, $tag, %$props; + fail "not owner of `$tag'", ".notowner", tag => $tag + unless $WHOSURE && $WHO eq $owner; +} + +sub get_pastebin_check_editkey_or_owner ($$$\%) { + my ($db, $tag, $editkey, $props) = @_; + + if (!defined $editkey) { get_pastebin_check_owner $db, $tag, %$props; } + else { + my ($owner, $hash) = get_pastebin $db, $tag, %$props; + fail "incorrect edit key for `$tag'", ".badhash", tag => $tag + unless $hash eq sha256_hex $editkey; + } +} + +sub rekey_pastebin ($) { + my ($tag) = @_; + + my $db = open_db; + my $editkey; + xact { + get_pastebin_check_owner $db, $tag, my %hunoz; + ($editkey, my $hash) = new_editkey; + $db->do("UPDATE odin_pastebin SET edithash = ? WHERE tag = ?", + undef, $hash, $tag); + } $db; + return $editkey; +} + +sub claim_pastebin ($$) { + my ($tag, $editkey) = @_; + + my $db = open_db; + $WHOSURE or fail "you can't claim pastes", ".notsure"; + xact { + get_pastebin_check_editkey_or_owner $db, $tag, $editkey, my %hunoz; + $db->do("UPDATE odin_pastebin SET owner = ? WHERE tag = ?", + undef, $WHO, $tag); + } $db; +} + +sub update_pastebin ($$\%) { + my ($tag, $editkey, $new) = @_; + + my $db = open_db; + my $editp = 0; + xact { + get_pastebin_check_editkey_or_owner $db, $tag, $editkey, my %old; + for my $p (@PASTEBIN_PROPS) { + if (!defined $new->{$p}) { $new->{$p} = $old{$p}; } + else { + $db->do("UPDATE odin_pastebin SET $p = ? WHERE tag = ?", + undef, $new->{$p}, $tag) + unless $new->{$p} eq $old{$p}; + $editp = 1; + } + } + } $db; + return $editp; +} + +sub delete_pastebin (@) { + my @a = @_; + my $db = open_db; + xact { + while (@a) { + (my $tag, my $editkey, @a) = @a; + get_pastebin_check_editkey_or_owner $db, $tag, $editkey, my %hunoz; + $db->do("DELETE FROM odin_pastebin WHERE tag = ?", undef, $tag); + } + } $db; +} + +sub tidy_pastebin_content ($) { + my ($content) = @_; + return undef unless defined $content; + $content =~ tr/\r//d; + $content =~ s/([^\n])\z/$1\n/; + return $content; +} + +###----- That's all, folks -------------------------------------------------- + +1; diff --git a/mason/common/autohandler b/mason/common/autohandler new file mode 100644 index 0000000..9630ac8 --- /dev/null +++ b/mason/common/autohandler @@ -0,0 +1,60 @@ +<%perl> + Odin::set_mason_failproc $m; + Odin::cgi_who $r; + Odin::fetch_cookies $r; + $r->content_type("text/html; charset=utf8"); + $m->call_next; + +%# +<%method wrapper>\ +% $r->header_out(Status => $status) if defined $status; + + + + + + +<& SELF:header &> +\ +% defined $title ? $m->print($title) : $m->comp("SELF:title"); + + + + +<% $m->content %> +
+Written by Mark Wooding
+
+ + +<%args> + $status => undef + $title => undef + + +%# +<%method title>(Untitled page) +<%method header> +%# +<%method error>\ +<&| SELF:wrapper, status => $status, title => $title // $m->content &>\ +

\ +% if (defined $title) { +Error: <% $title %>\ +% } else { +Error\ +% } +

+

<% $m->content %> + +<%args> + $status => 500 + $title => undef + + +%# +<%once> + use utf8; + use Odin; + diff --git a/mason/pastebin/%edit b/mason/pastebin/%edit new file mode 100644 index 0000000..bdf3e27 --- /dev/null +++ b/mason/pastebin/%edit @@ -0,0 +1,64 @@ +<&| SELF:wrapper, title => "odin.gg Paste Bin" &> +

odin.gg Paste Bin

+%# +% my $sep = "
\n"; +% my $end = ""; +% if (length $tag) { +% $m->print($sep); + ">View + ">Delete +% $sep = ""; $end = "
\n"; +% } +% $m->print($end); +%# +
" + accept-charset="UTF-8" enctype="multipart/form-data"> +
+% if (defined $edit) { + +% } +%# + + +%# +
+%# + + +%# + + +%# + +%# +
+
+
+ +%# +<%args> + $content => "" + $tag => "" + $edit => undef + $lang => "txt" + $title => "(untitled)" + +%# +<%init> + my $db = Odin::open_db; + +%# +<%once> + use utf8; + diff --git a/mason/pastebin/%show b/mason/pastebin/%show new file mode 100644 index 0000000..972ef87 --- /dev/null +++ b/mason/pastebin/%show @@ -0,0 +1,46 @@ +<&| SELF:wrapper, + title => Odin::escapify($m, $title) . " (odin.gg Paste Bin)" &> +

odin.gg Paste Bin: <% $title %>

+
+ ">Raw +% if (defined $edit) { + ">Edit +% } +
+
+% if ($lang eq 'txt') {
+<% $content |h %>\
+% } else {
+<%perl>
+	my $kid = open my $fh, "-|" // die "fork: $!";
+	if ($kid == 0) {
+	  open my $hl, "|-", "highlight", "-Ohtml", "-f", "-t8", "-S$lang"
+	    or die "open highlight: $!";
+	  syswrite $hl, $content // die "highlight write: $!";
+	  close $hl or die "highlight kid: $!, $?";
+	  exit 0;
+	} else {
+	  while (sysread $fh, my $buf, 8192) { $m->print($buf); }
+	  close $fh and waitpid $kid, 0
+	    or die "highlight parent: $!, $?";
+	}
+
+% }
+
+ +%# +<%args> + $content + $title + $lang + $tag + $edit => undef + +%# +<%init> + my $db = Odin::open_db; + +%# +<%once> + use utf8; + diff --git a/mason/pastebin/.perl-lib b/mason/pastebin/.perl-lib new file mode 120000 index 0000000..58677dd --- /dev/null +++ b/mason/pastebin/.perl-lib @@ -0,0 +1 @@ +../../lib \ No newline at end of file diff --git a/mason/pastebin/autohandler b/mason/pastebin/autohandler new file mode 120000 index 0000000..f9fc784 --- /dev/null +++ b/mason/pastebin/autohandler @@ -0,0 +1 @@ +../common/autohandler \ No newline at end of file diff --git a/mason/pastebin/dhandler b/mason/pastebin/dhandler new file mode 100644 index 0000000..7014dca --- /dev/null +++ b/mason/pastebin/dhandler @@ -0,0 +1,80 @@ +<%perl> + my $tag = $m->dhandler_arg; + + sub set_handoff_cookie ($$%) { + my ($tag, $edit, %attr) = @_; + Odin::bake_cookie $r, "odin-handoff.$tag=$edit", + -path => "$Odin::PASTEBIN_PATH/", %attr; + } + + my %props = ( + lang => $lang, title => $title, + content => Odin::tidy_pastebin_content $content + ); + + if (length $tag) { + + if (!defined $edit) { + my $db = Odin::open_db; + Odin::get_pastebin $db, $tag, my %old; + if ($op eq "raw") { + $r->content_type("text/plain; charset=utf8"); + $m->print($old{content}); + } else { + $m->comp("%show", tag => $tag, %old, + edit => $Odin::COOKIE{"odin-handoff.$tag"}); + } + } else { + if ($op eq "del") { + Odin::delete_pastebin $tag, $edit; + set_handoff_cookie $tag, "nil", -max_age => 5; + $m->redirect("$Odin::PASTEBIN/"); + } else { + my $editp = Odin::update_pastebin $tag, $edit, %props; + set_handoff_cookie $tag, $edit; + if ($editp) { $m->redirect("$Odin::PASTEBIN/$tag"); } + else { $m->comp("%edit", tag => $tag, edit => $edit, %props); } + } + } + } elsif (defined $content) { + ($tag, $edit) = Odin::new_pastebin %props; + set_handoff_cookie $tag, $edit; + $m->redirect("$Odin::PASTEBIN/$tag"); + } else { + Odin::path_info($r) =~ m:/$: + or $m->redirect("$Odin::PASTEBIN/", 301); + $m->comp("%edit"); + } + +%# +<%args> + $content => undef + $edit => undef + $lang => undef + $title => undef + $op => "edit" + +%# +<%def .notfound> +<&| SELF:error, title => "not found", status => 404 &>\ +tag ‘<% $tag %>’ not found + +<%args> + $tag + + +%# +<%def .badhash> +<&| SELF:error, status => 404 &>\ +incorrect edit key + +<%args> + $tag + + +%# +<%once> + use utf8; + use Digest::SHA qw(sha256_hex); + use Odin; + diff --git a/mason/shorturl/.perl-lib b/mason/shorturl/.perl-lib new file mode 120000 index 0000000..58677dd --- /dev/null +++ b/mason/shorturl/.perl-lib @@ -0,0 +1 @@ +../../lib \ No newline at end of file diff --git a/mason/shorturl/autohandler b/mason/shorturl/autohandler new file mode 120000 index 0000000..f9fc784 --- /dev/null +++ b/mason/shorturl/autohandler @@ -0,0 +1 @@ +../common/autohandler \ No newline at end of file diff --git a/mason/shorturl/dhandler b/mason/shorturl/dhandler new file mode 100644 index 0000000..bddcab7 --- /dev/null +++ b/mason/shorturl/dhandler @@ -0,0 +1,64 @@ +<&| SELF:wrapper, title => "odin.gg URL Shortener" &> +

odin.gg URL Shortener

+
+ + "> + +
+% if (defined $tag) { +

Shortened to: "><% + "$Odin::SHORTURL/$tag" %> +% } + +%# +<%init> + my $tag = $m->dhandler_arg; + if (length $tag) { + my $url = Odin::get_shorturl $tag; + if ($q) { $m->comp(".query", url => $url); } + else { $m->redirect($url, 301); } + return; + } elsif (defined $u) { + $tag = Odin::new_shorturl $u; + } else { + Odin::path_info($r) =~ m:/$: + or $m->redirect("$Odin::SHORTURL/", 301); + $tag = undef; + } + +%# +<%args> + $q => undef + $u => undef + +%# +<%def .query>\ +% $r->content_type("text/plain; charset=utf8"); +<% $url %> +<%args> + $url + + +%# +<%def .notfound>\ +<&| SELF:error, title => "not found", status => 404 &>\ +tag ‘<% $tag |h %>’ not found + +<%args> + $tag + + +%# +<%def .badurl>\ +<&| SELF:error, title => "invalid url", status => 404 &>\ +‘<% $u |h %>’ is not a valid URL + +<%args> + $u + + +%# +<%once> + use utf8; + use Odin; + diff --git a/sql/setup-pastebin.sql b/sql/setup-pastebin.sql new file mode 100644 index 0000000..06d3544 --- /dev/null +++ b/sql/setup-pastebin.sql @@ -0,0 +1,40 @@ +/* -*-sql-*- + * + * Plain old SQL for setting up the tables for Odin web services. + */ + +/* The various tools assume that the database is appropriate configured with + * the SERIALIZABLE isolation level. + */ + +begin; + +drop table if exists odin_pastebin; +drop table if exists odin_pastebin_lang; +drop table if exists odin_pastebin_seq; + +create table odin_pastebin_lang + (lang varchar(32) primary key + descr varchar(64) not null); +insert into odin_pastebin_lang (lang, descr) values ('txt', 'Plain text'); + +create table odin_pastebin_seq (seq int); +insert into odin_pastebin_seq (seq) values (10000); + +create table odin_pastebin + (tag varchar(16) primary key, + stamp timestamp not null default current_timestamp, + edithash varchar(128) not null, + owner varchar(64) not null, + title varchar(128) not null, + lang varchar(32) not null + default 'plain-text' + references odin_pastebin_lang (lang) + on update cascade + on delete set default + deferrable initially deferred, + content text not null); +create index odin_pastebin_by_lang on odin_pastebin (lang); +create index odin_pastebin_by_owner on odin_pastebin (owner); + +commit; diff --git a/sql/setup-shorturl.sql b/sql/setup-shorturl.sql new file mode 100644 index 0000000..b2ff717 --- /dev/null +++ b/sql/setup-shorturl.sql @@ -0,0 +1,25 @@ +/* -*-sql-*- + * + * Plain old SQL for setting up the tables for Odin web services. + */ + +/* The various tools assume that the database is appropriate configured with + * the SERIALIZABLE isolation level. + */ + +begin; + +drop table odin_shorturl; +drop table odin_shorturl_seq; + +create table odin_shorturl_seq (seq int); +insert into odin_shorturl_seq (seq) values (10000); + +create table odin_shorturl + (tag varchar(16) primary key, + stamp timestamp not null default current_timestamp, + owner varchar(64) not null, + url text not null); +create index odin_shorturl_by_owner on odin_shorturl (owner); + +commit; diff --git a/static/odin.css b/static/odin.css new file mode 100644 index 0000000..80e23fc --- /dev/null +++ b/static/odin.css @@ -0,0 +1,40 @@ +div.footer { + margin-top: 2ex; + border-top: solid thin black; + padding-top: 1ex; + clear: both; + text-align: right; + font-style: italic; +} + +div.menu { + border-bottom: solid thin black; + padding-bottom: 1ex; + margin-bottom: 2ex; +} + +div.menu > .item:first-child:before { + content: "" +} + +div.menu > .item:before { + content: " | " +} + +.invis { + display: none; +} + +.num { color: #a5a50b; } +.esc, .str, .dstr, .pps { color: #188fb6; } +.com, .slc { color: #2e8b57; font-style: italic; } +.dir, .kwa, .kwb, .kwc, .ppc { color: #000000; font-weight: bold; } +.kwd { color: #000000; } +.sym, .opt { color: #c7831d; } +.line { color: #555555; } + +input#url { min-width: 48em; } +input#title { min-width: 24em; } + +div.pastebin { float: left; } +div.paste-widgets { text-align: center; margin: 1ex; }