Vector is ready for production
+RewriteEngine On
+
+RewriteCond %{REQUEST_URI} !^/vector/auth\.pl
+RewriteRule ^auth(.*)$ auth.pl$1 [L]
+
+RewriteCond %{REQUEST_URI} !^/vector/rss\.fcgi
+RewriteRule ^rss(.*)$ rss.fcgi$1 [L]
+
+RewriteCond %{REQUEST_URI} !^/vector/static
+RewriteCond %{REQUEST_URI} !^/vector/thumb
+RewriteCond %{REQUEST_URI} !^/vector/data
+RewriteCond %{REQUEST_URI} !^/vector/rss\.fcgi
+RewriteCond %{REQUEST_URI} !^/vector/index\.fcgi
+RewriteCond %{REQUEST_URI} !^/vector/auth\.pl
+RewriteRule ^(.*)$ index.fcgi/$1 [L]
+package Vector::Auth;
+use Exporter 'import';
+our @EXPORT_OK = qw/authbox/;
+
+use CGI::Fast qw/:standard/;
+use Vector::Config qw/$webroot/;
+use strict;
+
+my $auth_uri = "${webroot}auth";
+
+sub authbox {
+ my ($session) = @_;
+
+ print qq{<script type="text/javascript" src="${webroot}static/popup.js"></script>};
+ print '<div class="authbox">';
+ if ($session->param('id')) {
+ my $id = $session->param('id');
+ my $username = $session->param('username');
+ my $displayname = $session->param('displayname');
+ print qq{Logged in as <a href="$username"><img src="${webroot}static/openid-16x16.gif">$displayname</a> - <a href="$auth_uri?logout=1">logout</a>};
+ } else {
+ print start_form(-method => 'POST', -action => $auth_uri, -class => 'openid'),
+ 'login: ',
+ textfield(-name => 'login', -class => 'openid', -onfocus => "popup('openid')", -onblur => "popout('openid')"),
+ div({-class => 'popup', -id => 'popup_openid'}, 'Input your OpenID to log in. As a special shortcut, a single word will be expanded to http://id.dominionofawesome.com/{user}. If you do not have an OpenID, you can create one at the <a href="http://id.dominionofawesome.com/">Dominion of Awesome ID Services</a>.'),
+ end_form;
+ }
+ print '</div>';
+}
+
+1;
+package Vector::Channel;
+use Vector::DB;
+use strict;
+
+sub list {
+ my ($name, %opts) = @_;
+ my $dbh = Vector::DB::connect;
+ my $channel_id = id($name);
+
+ $opts{limit} = 10 unless exists $opts{limit};
+
+ unless ($channel_id) {
+ return ();
+ }
+
+ return @{$dbh->selectcol_arrayref('SELECT posts.post_id FROM posts LEFT JOIN threads ON posts.post_id = threads.post_id WHERE replyto IS NULL AND channel_id = ? ORDER BY updated ASC LIMIT ?', undef, $channel_id, $opts{limit})};
+}
+
+sub list_all {
+ my ($name, %opts) = @_;
+ my $dbh = Vector::DB::connect;
+
+ my $channel_id = id($name);
+
+ $opts{limit} = 100 unless exists $opts{limit};
+
+ return @{$dbh->selectcol_arrayref('SELECT post_id FROM posts WHERE channel_id = ? ORDER BY ts ASC LIMIT ?', undef, $channel_id, $opts{limit})};
+}
+
+sub list_channels {
+ my (%opts) = @_;
+ my $dbh = Vector::DB::connect;
+
+ $opts{limit} = 100 unless exists $opts{limit};
+
+ return @{$dbh->selectcol_arrayref('SELECT channel_id FROM channels ORDER BY updated ASC limit ?', undef, $opts{limit})};
+}
+
+sub id {
+ my ($name) = @_;
+ my $dbh = Vector::DB::connect;
+
+ my ($channel_id) = $dbh->selectrow_array('SELECT channel_id FROM channels WHERE name = ?', undef, $name);
+
+ return $channel_id;
+}
+
+sub name {
+ my ($channel_id) = @_;
+ my $dbh = Vector::DB::connect;
+
+ my ($name) = $dbh->selectrow_array('SELECT name FROM channels WHERE channel_id = ?', undef, $channel_id);
+
+ return $name;
+}
+
+sub create {
+ my ($name) = @_;
+ my $dbh = Vector::DB::connect;
+
+ $dbh->do('INSERT INTO channels (name) VALUES (?)', undef, $name);
+
+ my ($channel_id) = $dbh->selectrow_array('SELECT channel_id FROM channels WHERE name = ?', undef, $name);
+
+ return $channel_id;
+}
+
+sub update {
+ my ($channel_id) = @_;
+ my $dbh = Vector::DB::connect;
+
+ $dbh->do('UPDATE channels SET updated=NOW() WHERE channel_id = ?', undef, $channel_id)
+ or die "Could not update channel time for channel $channel_id";
+}
+
+1;
+package Vector::Config;
+use Exporter 'import';
+@EXPORT_OK = qw/$max_upload_size $thumbdir $datadir $webroot/;
+
+our $max_upload_size = 2 * 2**20; # 2MB
+our $thumbdir = '/home/doa/dominionofawesome.com/vector/thumb/';
+our $datadir = '/home/doa/dominionofawesome.com/vector/data/';
+our $webroot = 'http://dominionofawesome.com/vector/';
+
+1;
+package Vector::DB;
+use DBI;
+use strict;
+
+sub connect {
+ my $dbh = DBI->connect_cached('DBI:mysql:database=doa_vector;host=mysql.dominionofawesome.com', 'awesome', 'g00b3r')
+ or die $DBI::errstr;
+ return $dbh;
+}
+
+1;
+package Vector::Error;
+use CGI::Fast qw/:standard/;
+use strict;
+
+sub error_page {
+ print header,
+ start_html('ERROR'),
+ h1('FFFFFFFFFFFFFUUUUUUUUUUUUUUUUUUUUUUUUUUUUU-'),
+ $@,
+ end_html;
+}
+
+1;
+package Vector::File;
+use CGI::Fast qw/:cgi/;
+use Digest::SHA;
+use Vector::Config qw/$datadir $thumbdir $max_upload_size/;
+use strict;
+
+sub store {
+ my $buf;
+
+ my $fh = upload('file');
+ return unless defined $fh;
+
+ die "File too large\n" if -s $fh > $max_upload_size;
+
+ my $filename = param('file');
+ $filename =~ s'^.*[/\\:]''; # trim path bits
+
+ my $tmpdir = "upload.$$";
+ mkdir "$datadir/$tmpdir";
+
+ my $hash = new Digest::SHA('sha256');
+ open FILE, '>', "$datadir/$tmpdir/$filename";
+ while (read($fh, $buf, 16384)) {
+ print FILE $buf;
+ $hash->add($buf);
+ }
+ close FILE;
+
+ my $file_id = $hash->hexdigest;
+
+ if (-d "$datadir/$file_id") {
+ unlink "$datadir/$tmpdir/$filename";
+ rmdir "$datadir/$tmpdir";
+
+ unless (-e "$datadir/$file_id/$filename") {
+ my ($oldfilename) = <$datadir/$file_id/*>;
+ link $oldfilename, "$datadir/$file_id/$filename";
+ }
+ } else {
+ rename "$datadir/$tmpdir", "$datadir/$file_id";
+
+ thumb($file_id, $filename);
+ }
+ return "$file_id/$filename";
+}
+
+sub thumb {
+ my ($file_id, $filename) = @_;
+
+ mkdir "$thumbdir/$file_id" unless -d "$thumbdir/$file_id";
+
+ my $r = system '/usr/bin/convert', "$datadir/$file_id/$filename", '-thumbnail', '200x200', "$thumbdir/$file_id/thumbnail.jpg";
+ if ($r >> 8) {
+ rmdir "$thumbdir/$file_id";
+ }
+}
+
+1;
+package Vector::Notify;
+use Mail::Message;
+use Vector::DB;
+use Vector::Util;
+use Vector::Channel;
+use Vector::User;
+use strict;
+
+sub get {
+ my ($user_id, $channel_id, $thread) = @_;
+ my $dbh = Vector::DB::connect;
+
+ my $watch_id;
+ if (defined $thread) {
+ ($watch_id) = $dbh->selectrow_array('SELECT watch_id FROM watch WHERE user_id = ? AND channel_id = ? AND thread = ?', undef, $user_id, $channel_id, $thread);
+ } else {
+ ($watch_id) = $dbh->selectrow_array('SELECT watch_id FROM watch WHERE user_id = ? AND channel_id = ? AND thread IS NULL', undef, $user_id, $channel_id);
+ }
+
+ return $watch_id;
+}
+
+sub set {
+ my ($user_id, $channel_id, $thread) = @_;
+ my $dbh = Vector::DB::connect;
+
+ if (defined $thread) {
+ $dbh->do('INSERT INTO watch (user_id, channel_id, thread) VALUES (?,?,?)', undef, $user_id, $channel_id, $thread)
+ or die $dbh->errstr;
+ } else {
+ $dbh->do('INSERT INTO watch (user_id, channel_id) VALUES (?,?)', undef, $user_id, $channel_id)
+ or die $dbh->errstr;
+ }
+
+ # Icky icky icky
+ my ($watch_id) = $dbh->selectrow_array('SELECT LAST_INSERT_ID()');
+}
+
+sub clear {
+ my ($user_id, $channel_id, $thread) = @_;
+ my $dbh = Vector::DB::connect;
+
+ if (defined $thread) {
+ $dbh->do('DELETE FROM watch WHERE user_id = ? AND channel_id = ? AND thread = ?', undef, $user_id, $channel_id, $thread);
+ } else {
+ $dbh->do('DELETE FROM watch WHERE user_id = ? AND channel_id = ? AND thread IS NULL', undef, $user_id, $channel_id);
+ }
+}
+
+sub widget {
+ my ($user_id, $channel_id, $thread) = @_;
+
+ my $type;
+ if (defined $thread) {
+ $type = 'thread';
+ } else {
+ $type = 'channel';
+ }
+
+ if (Vector::Notify::get($user_id, $channel_id, $thread)) {
+ return qq{You are currently getting email notifications for activity in this $type. <a href="?watch=off">Turn off notifications</a>.};
+ } else {
+ return qq{<a href="?watch=on">Turn on email notifications</a> for this $type.};
+ }
+}
+
+sub queue {
+ my ($message, $channel_id, $thread) = @_;
+ my $dbh = Vector::DB::connect;
+ my $sth;
+ my %watchers;
+
+ # Queue for everyone watching this thread
+ $sth = $dbh->prepare('SELECT users.user_id, users.email FROM watch LEFT JOIN users ON users.user_id = watch.user_id WHERE channel_id = ? AND thread = ?');
+ $sth->execute($channel_id, $thread);
+ while (my $row = $sth->fetchrow_hashref) {
+ next unless $row->{email};
+ $dbh->do('INSERT INTO notify (user_id, message) VALUES (?,?)', undef, $row->{user_id}, $message);
+ $watchers{$row->{user_id}}++;
+ }
+
+ # Queue for everyone watching this channel
+ $sth = $dbh->prepare('SELECT users.user_id, users.email FROM watch LEFT JOIN users ON users.user_id = watch.user_id WHERE channel_id = ? AND thread IS NULL');
+ $sth->execute($channel_id);
+ while (my $row = $sth->fetchrow_hashref) {
+ next unless $row->{email};
+ next if exists $watchers{$row->{user_id}}; # Don't notify twice
+ $dbh->do('INSERT INTO notify (user_id, message) VALUES (?,?)', undef, $row->{user_id}, $message)
+ or die $dbh->errstr;
+ }
+}
+
+sub send {
+ my ($user_id) = @_;
+ my $dbh = Vector::DB::connect;
+ my (@ids, @messages);
+
+ my $user = Vector::User->fetch_by_id($user_id);
+ my $dname = Vector::Util::simplify_uri($user->{username});
+ my $to = qq{"$dname" <$user->{email}>};
+
+ my $sth = $dbh->prepare('SELECT notify_id, message FROM notify WHERE user_id = ?');
+ $sth->execute($user_id);
+ while (my $row = $sth->fetchrow_hashref) {
+ push @ids, $row->{notify_id};
+ push @messages, $row->{message};
+ }
+
+ my $msg = Mail::Message->build(
+ To => $to,
+ From => 'Vector <vector@dominionofawesome.com>',
+ Subject => @messages . ' new messages on Vector',
+ data => <<EOD . join("\n\n", @messages),
+When replying, make sure that the reply tag remains in your reply.
+
+EOD
+ );
+
+ $msg->send;
+
+ $dbh->begin_work;
+ foreach my $id (@ids) {
+ $dbh->do('DELETE FROM notify WHERE notify_id = ?', undef, $id);
+ }
+ $dbh->commit;
+}
+
+sub send_all {
+ my $dbh = Vector::DB::connect;
+
+ my $users = $dbh->selectcol_arrayref('SELECT DISTINCT user_id FROM notify');
+ foreach my $u (@$users) {
+ Vector::Notify::send($u);
+ }
+}
+
+1;
+package Vector::Paginator;
+use strict;
+
+sub new {
+ my ($class, $baseuri, $page, @items) = @_;
+
+ my $self = {
+ baseuri => $baseuri,
+ page => $page || 0,
+ items => \@items,
+ stride => 5,
+ };
+
+ return bless $self, $class;
+}
+
+sub count {
+ my ($self) = @_;
+ return int((@{$self->{items}} - 1) / $self->{stride});
+}
+
+sub page_items {
+ my ($self) = @_;
+
+ my $len = @{$self->{items}};
+ my $start = $self->{page} * $self->{stride};
+ if ($start >= $len) {
+ return ();
+ }
+ my $end = $start + $self->{stride} - 1;
+ if ($end >= $len) {
+ $end = $len - 1;
+ }
+
+ return @{$self->{items}}[$start..$end];
+}
+
+sub navigator {
+ my ($self) = @_;
+
+ my $count = $self->count;
+ my @r;
+
+ if ($self->{page} == 1) {
+ push @r, qq{<a href="$self->{baseuri}">prev</a>};
+ } elsif ($self->{page} > 0) {
+ my $ppage = $self->{page} - 1;
+ push @r, qq{<a href="$self->{baseuri}?page=$ppage">prev</a>};
+ } else {
+ push @r, 'prev';
+ }
+
+ for my $n (0..$count) {
+ my $uri;
+ if ($n == 0) {
+ $uri = $self->{baseuri};
+ } else {
+ $uri = "$self->{baseuri}?page=$n";
+ }
+ if ($n == $self->{page}) {
+ push @r, $n;
+ } else {
+ push @r, qq{<a href="$uri">$n</a>};
+ }
+ }
+
+ if ($self->{page} < $count - 1) {
+ my $npage = $self->{page} + 1;
+ push @r, qq{<a href="$self->{baseuri}?page=$npage">next</a>};
+ } else {
+ push @r, 'next';
+ }
+
+ return join(' ', @r);
+}
+
+1;
+package Vector::Post;
+use CGI::Fast qw/:standard/;
+use Vector::DB;
+use Vector::User;
+use Vector::Channel;
+use Vector::Thread;
+use Vector::Util qw/simplify_uri xmlescape/;
+use Vector::Config qw/$webroot $thumbdir $datadir/;
+use Vector::Notify;
+use Vector::ReplyTag;
+use strict;
+
+sub new {
+ my ($class, $user_id, $channel_id, $data, $file, $replyto) = @_;
+
+ my $self = {
+ type => 'post',
+ user_id => $user_id,
+ channel_id => $channel_id,
+ data => $data,
+ file => $file,
+ replyto => $replyto,
+ user => Vector::User->fetch_by_id($user_id),
+ channel => Vector::Channel::name($channel_id),
+ root => not defined $replyto,
+ };
+
+ return bless $self, $class;
+}
+
+sub load {
+ my ($class, $post_id) = @_;
+ my $dbh = Vector::DB::connect;
+
+ my $self = $dbh->selectrow_hashref('SELECT user_id, channel_id, data, file, replyto FROM posts WHERE post_id = ?', undef, $post_id);
+
+ $self->{type} = 'post';
+ $self->{user} = Vector::User->fetch_by_id($self->{user_id});
+ $self->{channel} = Vector::Channel::name($self->{channel_id});
+ $self->{post_id} = $post_id;
+ $self->{thread} = fetch Vector::Thread($self->{replyto} || $self->{post_id});
+ $self->{root} = not defined $self->{replyto};
+
+ return bless $self, $class;
+}
+
+sub save {
+ my ($self) = @_;
+ my $dbh = Vector::DB::connect;
+
+ if ($self->{post_id}) {
+ $dbh->do('UPDATE posts set data, ts) VALUES (?,NOW())', undef, $self->{data})
+ or die $dbh->errstr;
+ } else {
+ $dbh->do('INSERT INTO posts (user_id, channel_id, data, file, replyto, ts) VALUES (?,?,?,?,?,NOW())', undef, $self->{user_id}, $self->{channel_id}, $self->{data}, $self->{file}, $self->{replyto})
+ or die $dbh->errstr;
+
+ # Ick, MySQL-ism
+ ($self->{post_id}) = $dbh->selectrow_array('SELECT LAST_INSERT_ID()');
+
+ if ($self->{replyto}) {
+ $self->{thread} = fetch Vector::Thread($self->{replyto});
+ $self->{thread}->update;
+ } else {
+ $self->{thread} = new Vector::Thread($self->{post_id});
+ }
+ }
+
+ Vector::Channel::update($self->{channel_id});
+
+ $self->notify;
+
+ return $self->{post_id};
+}
+
+sub replies {
+ my ($self, %opts) = @_;
+ my $dbh = Vector::DB::connect;
+
+ if (defined $opts{limit}) {
+ $opts{offset} = 0 unless defined $opts{offset};
+ return @{$dbh->selectcol_arrayref('SELECT post_id FROM posts WHERE replyto = ? ORDER BY ts DESC LIMIT ? OFFSET ?', undef, $self->{post_id}, $opts{limit}, $opts{offset})};
+ } else {
+ return @{$dbh->selectcol_arrayref('SELECT post_id FROM posts WHERE replyto = ? ORDER BY ts DESC', undef, $self->{post_id})};
+ }
+}
+
+sub count_replies {
+ my ($self) = @_;
+ my $dbh = Vector::DB::connect;
+
+ my ($n) = $dbh->selectrow_array('SELECT count(*) FROM posts WHERE replyto = ?', undef, $self->{post_id});
+
+ return $n;
+}
+
+sub content {
+ my ($self) = @_;
+
+ my $r;
+
+ if ($self->{file}) {
+ my ($file_id, $filename) = split(m'/', $self->{file});
+
+ if (-e "$datadir/$self->{file}") {
+ my $thumburi;
+ if (-d "$thumbdir/$file_id") {
+ $thumburi = "${webroot}thumb/$file_id/thumbnail.jpg";
+ } else {
+ $thumburi = "${webroot}static/unknown-document.png";
+ }
+ $r .= a({href => "${webroot}data/$self->{file}", alt => $filename, title => $filename}, img({src => $thumburi, align => 'left'}));
+ $r .= "\n";
+ }
+ }
+ $r .= Vector::Util::linebreak(xmlescape $self->{data});
+
+ return $r;
+}
+
+sub format {
+ my ($self, $child_limit) = @_;
+ my (@controls);
+
+ my $shortname = simplify_uri $self->{user}->{username};
+ my $user_url = $self->{user}->user_url;
+ my $content = $self->content;
+
+ if (defined $child_limit && $self->{root}) {
+ push @controls, qq{<a href="${webroot}channel/$self->{channel}/$self->{post_id}">full thread</a>};
+ }
+
+ my $count_replies = $self->count_replies;
+ my @replies = reverse $self->replies(limit => $child_limit);
+ my @things;
+
+ if ($count_replies > @replies) {
+ push @things, qq{<li><a href="${webroot}channel/$self->{channel}/$self->{post_id}">... }, $count_replies - @replies, ' more replies</a></li>';
+ }
+
+ for my $r (@replies) {
+ my $post = load Vector::Post($r);
+ push @things, $post->format;
+ }
+
+ if ($self->{root} && $main::login_id) {
+ Delete('replyto');
+ my @expando = (-onfocus => 'reply_expand(this.parentNode)', -onblur => 'reply_compact(this.parentNode)');
+
+ my $form_options = {};
+ if (defined $child_limit) {
+ $form_options->{class} = 'compact';
+ }
+
+ push @things,
+ '<li>' .
+ start_form($form_options) .
+ hidden('replyto', $self->{post_id}) .
+ textarea(-name => 'data', @expando) . br .
+ filefield(-name => 'file', @expando) . br .
+ submit(-name => 'Reply', @expando) .
+ end_form .
+ '</li>';
+ }
+
+ return <<EOD;
+<li><a name="post$self->{post_id}"></a>
+ <div>
+ <div class="controls">@controls</div>
+ <h2><a href="$user_url">$shortname</a></h2>
+ $content
+ <div style="clear: both"></div>
+ </div>
+ @{[ @things ? "<ul>@things</ul>" : '' ]}
+</li>
+EOD
+}
+
+sub print {
+ my ($self, $child_limit) = @_;
+
+ print $self->format($child_limit);
+}
+
+sub notify {
+ my ($self) = @_;
+
+ my $replytag = Vector::ReplyTag::create($self);
+ my $display_username = simplify_uri($self->{user}->{username});
+
+ Vector::Notify::queue(<<EOD, $self->{channel_id}, $self->{thread}->{post_id});
+From $display_username $replytag
+$self->{data}
+EOD
+}
+
+sub post_uri {
+ my ($self) = @_;
+
+ return "${webroot}channel/$self->{channel}/$self->{thread}->{post_id}#post$self->{post_id}";
+}
+
+sub thread_uri {
+ my ($self) = @_;
+
+ return "${webroot}channel/$self->{channel}/$self->{thread}->{post_id}";
+}
+
+1;
+package Vector::RSS;
+use Vector::Config qw/$webroot/;
+use strict;
+
+my %rssbits = (
+ rss => sub { my $tree = shift; return <<RSS },
+<?xml version="1.0"?>
+<rss version="2.0">
+@{[ generate($tree->{main}) ]}
+</rss>
+RSS
+
+ thread => sub { my $tree = shift; return <<RSS },
+ <channel>
+ <title>Vector: #$tree->{xml_channel}/$tree->{xml_post_id}</title>
+ <link>${webroot}channel/$tree->{xml_channel}/$tree->{xml_post_id}</link>
+ <description>$tree->{xml_description}</description>
+@{[ loop_generate($tree->{items}) ]}
+ </channel>
+RSS
+
+ channel => sub { my $tree = shift; return <<RSS },
+ <channel>
+ <title>Vector: #$tree->{xml_channel}</title>
+ <link>${webroot}channel/$tree->{xml_channel}</link>
+@{[ loop_generate($tree->{items}) ]}
+ </channel>
+RSS
+
+ channels => sub { my $tree = shift; return <<RSS },
+ <channel>
+ <title>Vector</title>
+ <link>$webroot</link>
+@{[ loop_generate($tree->{channels}) ]}
+ </channel>
+RSS
+
+ post => sub { my $tree = shift; return <<RSS },
+ <item>
+ <link>${webroot}channel/$tree->{xml_channel}/$tree->{replyto}#post$tree->{post_id}</link>
+ <guid>${webroot}channel/$tree->{xml_channel}/$tree->{replyto}#post$tree->{post_id}</guid>
+ <title>$tree->{xml_username}</title>
+ <description>@{[ Vector::Util::xmlescape($tree->content) ]}</description>
+ </item>
+RSS
+
+ channel_item => sub { my $tree = shift; return <<RSS },
+ <item>
+ <link>${webroot}channel/$tree->{xml_channel}</link>
+ <guid>${webroot}channel/$tree->{xml_channel}</guid>
+ <title>#$tree->{xml_channel}</title>
+ </item>
+RSS
+);
+
+sub loop_generate {
+ my $trees = shift;
+
+ my $r = '';
+
+ foreach my $t (@$trees) {
+ $r .= generate($t);
+ }
+
+ return $r;
+}
+
+sub generate {
+ my ($tree) = @_;
+
+ unless (defined $tree->{type}) {
+ die "Type not defined for tree";
+ }
+
+ unless (defined $rssbits{$tree->{type}}) {
+ die "No bit for $tree->{type}";
+ }
+
+ safety_dance($tree);
+
+ return $rssbits{$tree->{type}}->($tree);
+}
+
+sub generate_rss {
+ my ($main) = @_;
+
+ return generate({type => 'rss', main => $main});
+}
+
+sub safety_dance {
+ my ($tree) = @_;
+
+ my @keys = grep { $_ ne 'type' && !/^xml_/ } keys %$tree;
+
+ foreach my $k (@keys) {
+ next if ref $tree->{$k};
+ $tree->{"xml_$k"} = Vector::Util::xmlescape($tree->{$k});
+ $tree->{"url_$k"} = Vector::Util::url_encode($tree->{$k});
+ }
+}
+
+1;
+package Vector::ReplyTag;
+use Digest::SHA qw/sha1/;
+use MIME::Base64;
+use Vector::Channel;
+use Vector::User;
+use strict;
+
+our $replytag_re = qr'\[replytag:([A-Za-z0-9+/=]{48})\]';
+
+my $secret = '/yeXjbdTz28pGboTta26wrF7GY/SdZf2L5MP1S1oRHX61d4pA2+I+42CPt+aiS8qO4VDb5VOy+NLlYv1ny2OaAEpEu56YNo4EApxDMJ826QnS2VeywWz578KWbKtptwO3KsxO9qeD/SCCr4kTwONxQUNCvGSYvgLoBOITtN7KG+5RRuvYx2HXQpYI3MjBlHP+xTy19MCmK/kYdPp8sjtfUSsSEYGNV6ZbVJY8eQDryewzRQNULyA1hXhPMidyXxv';
+
+sub calculate_hmac {
+ my ($channel, $thread, $username) = @_;
+
+ return sha1("$secret$channel$thread$username$secret");
+}
+
+sub create {
+ my ($post) = @_;
+
+ my $hmac = calculate_hmac($post->{channel}, $post->{thread}->{post_id}, $post->{user}->{username});
+ my $replytag = encode_base64(pack('LLLLA20', $post->{channel_id}, $post->{thread}->{post_id}, $post->{user_id}, 0, $hmac));
+ chomp $replytag;
+
+ return "[replytag:$replytag]";
+}
+
+sub decode {
+ my ($replytag) = @_;
+
+ if ($replytag =~ $replytag_re) {
+ my ($channel_id, $thread, $user_id, undef, $hmac) = unpack('LLLLA20', decode_base64($1));
+
+ my $channel = Vector::Channel::name($channel_id);
+ my $username = Vector::User->fetch_by_id($user_id)->{username};
+ my $hmac_v = calculate_hmac($channel, $thread, $username);
+
+ return unless $hmac eq $hmac_v;
+
+ return {
+ channel_id => $channel_id,
+ thread => $thread,
+ user_id => $user_id,
+ };
+ } else {
+ return undef;
+ }
+}
+
+1;
+package Vector::Thread;
+use Vector::DB;
+use strict;
+
+sub new {
+ my ($class, $post_id) = @_;
+ my $dbh = Vector::DB::connect;
+
+ $dbh->do('INSERT INTO threads (post_id, updated) VALUES (?, NOW())', undef, $post_id)
+ or die "Could not create thread $post_id";
+
+ return fetch Vector::Thread($post_id);
+}
+
+sub fetch {
+ my ($class, $post_id) = @_;
+ my $dbh = Vector::DB::connect;
+
+ my $self = $dbh->selectrow_hashref('SELECT post_id, updated FROM threads WHERE post_id = ?', undef, $post_id)
+ or die "Could not fetch thread $post_id";
+
+ return bless $self, $class;
+}
+
+sub save {
+ my ($self) = @_;
+ my $dbh = Vector::DB::connect;
+
+ $dbh->do('UPDATE threads SET updated =? WHERE post_id = ?', undef, $self->{updated}, $self->{post_id})
+ or die "Could not save thread $self->{post_id}";
+}
+
+sub update {
+ my ($self) = @_;
+ my $dbh = Vector::DB::connect;
+
+ $dbh->do('UPDATE threads SET updated=NOW() WHERE post_id = ?', undef, $self->{post_id});
+
+ ($self->{updated}) = $dbh->selectrow_array('SELECT updated FROM threads WHERE post_id = ?', undef, $self->{post_id});
+}
+
+1;
+package Vector::User;
+use Vector::DB;
+use Vector::Config qw/$webroot/;
+use strict;
+
+sub fetch_by_name {
+ my ($class, $username) = @_;
+ my $dbh = Vector::DB::connect;
+
+ my $self = $dbh->selectrow_hashref('SELECT user_id, joined, email FROM users WHERE username = ?', undef, $username);
+
+ if ($self) {
+ $self->{username} = $username;
+ return bless $self, $class;
+ } else {
+ return Vector::User->create($username);
+ }
+}
+
+sub fetch_by_id {
+ my ($class, $user_id) = @_;
+ my $dbh = Vector::DB::connect;
+
+ my $self = $dbh->selectrow_hashref('SELECT username, joined, email FROM users WHERE user_id = ?', undef, $user_id);
+
+ if ($self) {
+ $self->{user_id} = $user_id;
+ return bless $self, $class;
+ }
+}
+
+sub create {
+ my ($class, $username) = @_;
+ my $dbh = Vector::DB::connect;
+
+ $dbh->do('INSERT INTO users (username, joined) VALUES (?, NOW())', undef, $username);
+
+ my $self = {
+ username => $username,
+ email => undef
+ };
+
+ ($self->{user_id}, $self->{joined}) = $dbh->selectrow_array('SELECT user_id, joined FROM users WHERE username = ?', undef, $username);
+
+ return bless $self, $class;
+}
+
+sub save {
+ my ($self) = @_;
+ my $dbh = Vector::DB::connect;
+
+ $dbh->do('UPDATE users SET email = ? WHERE user_id = ?', undef, $self->{email}, $self->{user_id});
+}
+
+sub user_url {
+ my ($self) = @_;
+
+ my $username = $self->{username};
+ $username =~ s'://'/';
+
+ return "${webroot}user/$username";
+}
+
+1;
+package Vector::Util;
+use Exporter 'import';
+our @EXPORT_OK = qw/url_encode simplify_uri xmlescape/;
+use strict;
+
+sub url_encode {
+ local $_ = shift;
+ s/([^A-Za-z0-9_.-])/sprintf("%%%02X", ord($1))/seg;
+ return $_;
+}
+
+sub simplify_uri {
+ my ($uri) = @_;
+
+ if ($uri =~ m'https?://(?:([a-zA-Z0-9-.]+)\.)?([a-zA-Z0-9-]+\.[a-z]{2,5})/([^/]+)?') {
+ if ($1 && $3) {
+ if ($1 eq 'id') {
+ return "$3 [$2]";
+ } else {
+ return "$1.$2/$3";
+ }
+ } elsif ($1) {
+ return "$1 [$2]";
+ } elsif ($3) {
+ return "$3 [$2]";
+ } else {
+ return $2;
+ }
+ } else {
+ return $uri;
+ }
+}
+
+sub linebreak {
+ local $_ = shift;
+ s/(\015\012|\012|\015)/<br>$1/g;
+ return $_;
+}
+
+sub xmlescape {
+ local $_ = shift;
+ s/&/&/g;
+ s/</</g;
+ s/>/>/g;
+ s/"/"/g;
+
+ s/([\x80-\x{FFFFFF}])/sprintf("&#x%x;", ord($1))/eg;
+
+ return $_;
+}
+
+1;
+#!/usr/bin/perl
+use lib qw(/home/doa/perlmods/lib/perl/5.8 /home/doa/perlmods/lib/perl/5.8.8 /home/doa/perlmods/share/perl/5.8 /home/doa/perlmods/share/perl/5.8.8);
+
+use CGI qw/:cgi/;
+use CGI::Carp qw/fatalsToBrowser/;
+use CGI::Session;
+use Net::OpenID::Consumer;
+use LWPx::ParanoidAgent;
+use DBI;
+use Digest::SHA qw/sha256_base64/;
+use Vector::User;
+use strict;
+
+my $cgi = new CGI;
+my $session = new CGI::Session($cgi);
+
+sub consumer_secret {
+ my ($time) = @_;
+
+ return sha256_base64("nMgGvUbvI9fL7FafdUQQqcQL+LJBoygSSM8eKyLB7KztDCcoogHAuSbpUuNrGTnzpDewiVkSvL2DcWabNfrNIg${time}vyfC7rWPoimEN1e2T7NkUW8VKBIhGKTBwHEpMISw2DwNFhoraVNbmXTIeBChFPhTxkzkVOMAQTQQMZY9bi0h4M");
+}
+
+my $csr = Net::OpenID::Consumer->new(
+ ua => LWPx::ParanoidAgent->new,
+ args => $cgi,
+ consumer_secret => \&consumer_secret,
+ required_root => "http://dominionofawesome.com/vector/"
+);
+
+if (param('openid.mode')) {
+ $csr->handle_server_response(
+ not_openid => sub {
+ die "Not an OpenID message";
+ },
+ setup_required => sub {
+ my $setup_url = shift;
+ print redirect($setup_url);
+ exit 0;
+ },
+ cancelled => sub {
+ # Do something appropriate when the user hits "cancel" at the OP
+ print redirect('http://dominionofawesome.com/vector/');
+ exit 0;
+ },
+ verified => sub {
+ my $vident = shift;
+ # Do something with the VerifiedIdentity object $vident
+ my $user = Vector::User->fetch_by_name($vident->url)
+ or die "Could not fetch user";
+ $session->param('id', $user->{user_id});
+ $session->param('username', $vident->url);
+ $session->param('displayname', $vident->display);
+ $session->flush();
+
+ print redirect('http://dominionofawesome.com/vector/');
+ exit 0;
+ },
+ error => sub {
+ my ($errcode, $errtext) = @_;
+ die("$errcode: $errtext");
+ },
+ );
+} elsif (param('login')) {
+ my $uri = param('login');
+
+ # Cheat
+ if ($uri =~ /^\w+$/) {
+ $uri = "http://id.dominionofawesome.com/$uri";
+ }
+ my $claimed_identity = $csr->claimed_identity($uri);
+
+ my $check_url = $claimed_identity->check_url(
+ return_to => 'http://dominionofawesome.com/vector/auth',
+ trust_root => 'http://dominionofawesome.com/vector/',
+ delayed_return => 1,
+ );
+
+ print redirect($check_url);
+ exit 0;
+} elsif (param('logout')) {
+ $session->clear();
+ $session->flush();
+
+ print redirect('http://dominionofawesome.com/vector/');
+ exit 0;
+} else {
+ print "Content-type: text/plain\r\n\r\n";
+ my @params = param();
+ print "@params\n";
+}
+#!/usr/bin/perl
+use CGI::Fast qw/:standard/;
+use CGI::Session;
+#use CGI::Carp qw/fatalsToBrowser/;
+use Vector::Config qw/$webroot/;
+use Vector::Util qw/url_encode/;
+use Vector::Channel;
+use Vector::Post;
+use Vector::Auth qw/authbox/;
+use Vector::Paginator;
+use Vector::File;
+use Vector::Notify;
+use Vector::Error;
+use strict;
+
+our ($login_id, $login_user);
+my ($type, $object, $subobject, @extra);
+my ($pobject, $plink, $head);
+
+sub page_setup {
+ my ($session) = @_;
+
+ if ($type eq 'channel') {
+ $pobject = "#$object";
+ $plink = "${webroot}channel/$object";
+ if (defined $subobject) {
+ $head = qq{<link rel="alternate" type="application/rss+xml" title="Thread $subobject in #$object [RSS]" href="${webroot}rss/$object/$subobject">};
+ } else {
+ $head = qq{<link rel="alternate" type="application/rss+xml" title="All posts in #$object [RSS]" href="${webroot}rss/$object">};
+ }
+
+ if ($login_id) {
+ if (param('Reply')) {
+ my $channel_id = Vector::Channel::id($object);
+ my $replyto = param('replyto');
+ my $file = Vector::File::store;
+ my $post = new Vector::Post($login_id, $channel_id, param('data'), $file, $replyto);
+ $post->save;
+
+ print redirect($post->post_uri);
+ next REQUEST;
+ } elsif (param('Start Thread')) {
+ my $channel_id = Vector::Channel::id($object);
+ unless ($channel_id) {
+ $channel_id = Vector::Channel::create($object);
+ }
+ my $file = Vector::File::store;
+ my $post = new Vector::Post($login_id, $channel_id, param('data'), $file);
+ $post->save;
+
+ print redirect($post->thread_uri);
+ next REQUEST;
+ } elsif (url_param('watch')) {
+ my $channel_id = Vector::Channel::id($object);
+ if (url_param('watch') eq 'on') {
+ Vector::Notify::set($login_id, $channel_id, $subobject);
+ } else {
+ Vector::Notify::clear($login_id, $channel_id, $subobject);
+ }
+
+ print redirect("${webroot}channel/$object" . (defined $subobject ? "/$subobject" : ''));
+ next REQUEST;
+ }
+ }
+ } elsif ($type eq 'user') {
+ $plink = "${webroot}user/$object/" . join('/', @extra);
+ $object = $object . '://' . @extra[0] . '/' . join('/', splice(@extra, 1));
+ $pobject = "~$object";
+
+ if ($login_user->{username} eq $object) {
+ if (param('Save')) {
+ $login_user->{email} = param('email');
+ $login_user->save;
+
+ print redirect($login_user->user_url);
+ next REQUEST;
+ }
+ }
+ } else {
+ $pobject = 'Home';
+ $plink = $webroot;
+ $head = qq{<link rel="alternate" type="application/rss+xml" title="Channel List [RSS]" href="${webroot}rss">};
+
+ if ($login_id) {
+ if (param('Create or Join Channel')) {
+ my $channel = param('channel');
+ $channel =~ s/^#//;
+ print redirect($webroot . 'channel/' . url_encode($channel));
+ next REQUEST;
+ }
+ }
+ }
+
+ Delete('data');
+}
+
+sub page_display {
+ my ($session) = @_;
+
+ print $session->header,
+ start_html(
+ -title => "Vector: $pobject",
+ -style => "${webroot}static/style.css",
+ -head => <<HEAD
+<link rel="icon" type="image/png" href="${webroot}static/favicon.png">
+<script type="text/javascript" src="${webroot}static/ui.js"></script>
+$head
+HEAD
+ );
+
+ print h1(a({href => $plink}, $pobject));
+
+ authbox($session);
+ if ($login_id) {
+ print div({style => 'text-align: right'}, a({href => $login_user->user_url}, 'Preferences'));
+ }
+
+ if ($type eq 'channel') {
+ my $channel_id = Vector::Channel::id($object);
+
+ if (defined $subobject) {
+ my $head = load Vector::Post($subobject);
+
+ if ($login_id) {
+ print p, Vector::Notify::widget($login_id, $channel_id, $subobject);
+ }
+
+ print '<ul class="posts">';
+ $head->print;
+ print '</ul>';
+ } else {
+ my $paginator = new Vector::Paginator("$webroot$type/$object", param('page') || 0, reverse Vector::Channel::list($object));
+ my $navigator = $paginator->navigator;
+ my @heads = map { load Vector::Post($_) } $paginator->page_items;
+
+ if ($login_id) {
+ print p, Vector::Notify::widget($login_id, $channel_id);
+ }
+
+ print p, $navigator;
+
+ print '<ul class="posts">';
+ foreach my $h (@heads) {
+ $h->print(10);
+ }
+ print '</ul>';
+
+ print p, $navigator;
+
+ if ($login_id) {
+ print h2('Start Thread');
+ print start_form,
+ textarea('data', '', 5, 60), br,
+ filefield(-name => 'file'), br,
+ submit('Start Thread'),
+ end_form;
+ }
+ }
+ } elsif ($type eq 'user') {
+ if ($login_id) {
+ if ($object eq $login_user->{username}) {
+ print start_form,
+ 'Email: ', textfield('email', $login_user->{email}, 40),
+ p, submit('Save'),
+ end_form;
+ }
+ }
+ } else {
+ if ($login_id) {
+ print start_form,
+ textfield('channel', '', 20),
+ submit('Create or Join Channel'),
+ end_form;
+ }
+ }
+
+ print end_html;
+}
+
+REQUEST:
+while (my $q = new CGI::Fast) {
+ my $session = new CGI::Session($q);
+
+ $login_id = $session->param('id');
+ if ($login_id) {
+ $login_user = Vector::User->fetch_by_id($login_id);
+ }
+
+ (undef, $type, $object, @extra) = split(m'/', $ENV{PATH_INFO});
+ $subobject = $extra[0];
+
+ eval { page_setup($session) };
+ if ($@) {
+ Vector::Error::error_page;
+ next REQUEST;
+ }
+
+ eval { page_display($session) };
+ if ($@) {
+ print "Kaboom: $@";
+ }
+}
+#!/usr/bin/perl
+use CGI::Fast qw/:cgi/;
+use Vector::RSS;
+use Vector::Post;
+use Vector::Channel;
+use strict;
+
+REQUEST:
+while (my $q = new CGI::Fast) {
+ my (undef, $channel, $thread) = split(m'/', $ENV{PATH_INFO});
+
+ print header(-type => 'application/rss+xml');
+
+ if ($channel) {
+ if ($thread) {
+ my $head = load Vector::Post $thread;
+ my @children = map { load Vector::Post $_ } $head->replies;
+
+ print Vector::RSS::generate_rss({
+ type => 'thread',
+ description => $head->{data},
+ channel => $channel,
+ post_id => $thread,
+ items => \@children,
+ });
+ } else {
+ my @posts = map { load Vector::Post $_ } Vector::Channel::list_all($channel);
+ print Vector::RSS::generate_rss({
+ type => 'channel',
+ description => "All posts from $channel",
+ channel => $channel,
+ items => \@posts,
+ });
+ }
+ } else {
+ # channel list
+ my @channels = map {
+ {
+ type => 'channel_item',
+ channel => Vector::Channel::name($_)
+ }
+ } Vector::Channel::list_channels;
+
+ print Vector::RSS::generate_rss({
+ type => 'channels',
+ channels => \@channels
+ });
+ }
+}
+CREATE TABLE users (
+ user_id integer primary key auto_increment,
+ joined datetime,
+ username varchar(255) NOT NULL,
+ email varchar(255)
+);
+
+CREATE TABLE channels (
+ channel_id integer primary key auto_increment,
+ updated datetime,
+ name varchar(255) NOT NULL
+);
+
+CREATE TABLE posts (
+ post_id integer primary key auto_increment,
+ user_id integer NOT NULL,
+ channel_id integer NOT NULL,
+ ts datetime NOT NULL,
+ replyto integer,
+ file varchar(255),
+ data text NOT NULL,
+ CONSTRAINT FOREIGN KEY (user_id) REFERENCES users (user_id) ON DELETE CASCADE,
+ CONSTRAINT FOREIGN KEY (channel_id) REFERENCES channels (channel_id) ON DELETE CASCADE,
+ CONSTRAINT FOREIGN KEY (replyto) REFERENCES posts (post_id) ON DELETE CASCADE
+);
+
+CREATE TABLE threads (
+ post_id integer primary key,
+ updated datetime,
+ CONSTRAINT FOREIGN KEY (post_id) REFERENCES posts (post_id) ON DELETE CASCADE
+);
+
+CREATE TABLE watch (
+ watch_id integer primary key auto_increment,
+ channel_id integer NOT NULL,
+ thread integer,
+ user_id integer NOT NULL,
+ CONSTRAINT FOREIGN KEY (channel_id) REFERENCES channels (channel_id) ON DELETE CASCADE
+);
+
+CREATE TABLE notify (
+ notify_id integer primary key auto_increment,
+ user_id integer NOT NULL,
+ message text NOT NULL,
+ CONSTRAINT FOREIGN KEY (user_id) REFERENCES users (user_id) ON DELETE CASCADE
+);
+function popup(id) {
+ var p = document.getElementById('popup_' + id);
+ setTimeout(function() {
+ p.style.display = 'block';
+ }, 500);
+}
+
+function popout(id) {
+ var p = document.getElementById('popup_' + id);
+ setTimeout(function() {
+ p.style.display = '';
+ }, 500);
+}
+body {
+ font-family: sans-serif;
+ margin: 1em;
+}
+
+a > img {
+ border: 0;
+}
+
+h1 {
+ margin: 0;
+ font-size: 18pt;
+}
+
+h1 > a, h2 > a {
+ color: black;
+ text-decoration: none;
+}
+
+h1 > a:hover, h2 > a:hover {
+ text-decoration: underline;
+}
+
+form {
+ margin: 0;
+}
+
+.authbox {
+ text-align: right;
+ position: absolute;
+ right: 1em;
+ top: 1em;
+}
+
+.popup {
+ text-align: left;
+ background-color: white;
+ border: 1px solid black;
+ margin-top: 4pt;
+ padding: 2pt;
+ display: none;
+ width: 5in;
+}
+
+form.openid {
+ font-size: 14px;
+}
+
+input.openid {
+ font-size: 14px;
+ background-image: url(/tree/static/openid-16x16.gif);
+ background-repeat: no-repeat;
+ background-position: 1px 50%;
+ padding-left: 18px;
+ border: 1px solid black;
+}
+
+.error {
+ margin: 4pt 0;
+ font-weight: bold;
+}
+
+ul.posts {
+ margin: 0;
+ margin: 1em 0;
+ padding-left: 0;
+}
+
+ul.posts ul {
+ margin: 0.5em 0;
+ padding-left: 2em;
+}
+
+ul.posts li {
+ list-style-type: none;
+ padding: 4pt;
+}
+
+ul.posts textarea[name=data] {
+ width: 40em;
+ height: 10em;
+}
+
+ul.posts input[type=file] {
+ width: 40em;
+}
+
+ul.posts h2 {
+ font-size: 12pt;
+ margin: 0 0 4pt 0;
+}
+
+ul.posts li > div > a > img {
+ margin: 0 4pt 0 0;
+}
+
+ul.posts li + li {
+ border-top: 2px solid black;
+}
+
+ul.posts > li + li {
+ border-top: none;
+ margin: 3em 0;
+}
+
+/* compact form */
+form.compact input {
+ display: none;
+}
+
+form.compact textarea[name="data"] {
+ height: 2em;
+ width: 20em;
+}
+
+var compact_timer;
+
+function reply_expand(e) {
+ clearTimeout(compact_timer);
+ compact_timer = undefined;
+ e.className = '';
+}
+
+function reply_compact(e) {
+ compact_timer = setTimeout(function() {
+ e.className = 'compact';
+ }, 500);
+}