#!/usr/bin/perl -w # # shinGETsu - P2P anonymous BBS # # (c) Fuktommy # Released under the GNU General Public License # $Id: tradgw.cgi,v 1.12 2004/02/23 12:38:59 fuktommy Exp $ # use lib qw(..); use IPC::Open2; use Shingetsu::Config; use Shingetsu::NodeList; use Shingetsu::Cache; use Shingetsu::CacheStat; use Shingetsu::Signature; use Shingetsu::Util; umask $Shingetsu::Config::umask; sub xlocaltime(;$) { Shingetsu::Util::localtime(@_) } sub xdie(;@) { print "Content-Type: text/plain;\r\n", "X-Shingetsu: shinGETsu/$Shingetsu::Config::version\r\n", "\r\n", @_, "\n"; exit; } sub rec_thread($) { local($_) = @_; @_ = split /<>/, $_, -1; return (stamp=> shift @_, id=> shift @_) if (@_ < 4); my %rec = (stamp=> shift @_, id=> shift @_); $rec{name} = shift @_; $rec{TARGET} = "$rec{name}"; $rec{mail} = shift @_; $rec{TARGET} .= "<>$rec{mail}"; $rec{body} = shift @_; $rec{TARGET} .= "<>$rec{body}"; if (@_) { $rec{suffix} = shift @_; $rec{TARGET} .= "<>$rec{suffix}"; $rec{attach} = shift @_; $rec{TARGET} .= "<>$rec{attach}"; } my $flag = 0; foreach (@_) { my @buf = split /:/, $_, 2; if ((! $flag) && (defined $buf[0]) && ($buf[0] ne "pubkey")) { $rec{TARGET} .= "<>$_"; } else { $flag = 1; } next if (@buf < 2); $rec{$buf[0]} = $buf[1]; } return %rec; } sub check_traditional_signature(%) { my(%rec) = @_; my $md5 = Shingetsu::Extern::md5digest($rec{TARGET}); # $md5 = pack 'H*', $md5; $md5 = Shingetsu::Extern::base64encode($md5); open2($IN, $OUT, $Shingetsu::Config::command{apollo}, "-v"); print $OUT "$md5\n$rec{sign}\n$rec{pubkey}\n"; close $OUT; my $flag = <$IN>; close $IN; wait; chomp($flag); return ($flag eq "True"); } sub generate_traditional_signature($$) { my($keygen, $str) = @_; open2($IN, $OUT, $Shingetsu::Config::command{apollo}, "-g"); print $OUT "$keygen\n"; close $OUT; my $pubkey = <$IN>; my $prikey = <$IN>; close $IN; wait; chomp($pubkey, $prikey); my $md5 = Shingetsu::Extern::md5digest($str); # $md5 = pack 'H*', $md5; $md5 = Shingetsu::Extern::base64encode($md5); open2($IN, $OUT, $Shingetsu::Config::command{apollo}, "-s"); print $OUT "$md5\n$pubkey\n$prikey\n"; close $OUT; my $sign = <$IN>; close $IN; wait; chomp($sign); return ($pubkey, $sign); } $datadir = $Shingetsu::Config::datadir; $menufile = $Shingetsu::Config::menufile; if ($ENV{REMOTE_ADDR} !~ $Shingetsu::Config::friendAddr) { print403(); exit; } elsif (defined $ENV{PATH_INFO}) { $path = $ENV{PATH_INFO}; $path =~ s|^/||; } else { $path = ""; } if ($ENV{REQUEST_METHOD} eq "POST") { read(STDIN, $buf, $ENV{CONTENT_LENGTH}); } if (($path eq "")||($path eq "TITLE")) { printTitle(); } elsif ($path eq "MENU") { printMenu($menufile); } elsif ($path eq "MOTD") { printMotd(); } elsif ($path =~ m|^MENU/([0-9A-Za-z_]+)$|) { printMenu($1); } elsif ($path =~ m|^BOARD/([0-9A-Za-z_]+)$|) { printBoard($1); } elsif ($path =~ m|^THREAD/([0-9A-Za-z_]+)$|) { printThread($1); } elsif ($path =~ m|^ATTACH/([0-9A-Za-z_]+)/([0-9A-Za-z_]+)/([0-9]+)\.([0-9A-Za-z_]*)$|) { printAttach($1, $2, $3, $4); } elsif ($path eq "CHECK") { checkSign(); } elsif ($path =~ m|^POST/([0-9A-Za-z_]+)$|) { my $num = $1; my $id = post($num, $buf); print302("http://$ENV{HTTP_HOST}$ENV{SCRIPT_NAME}/THREAD/$num#r$id"); } elsif ($path =~ m|^NEWTHREAD/([0-9A-Za-z_]+)$|) { my $num = $1; my $thread = newThread($num, $buf); print302("http://$ENV{HTTP_HOST}$ENV{SCRIPT_NAME}/BOARD/$num"); } elsif ($path =~ m|^NEWBOARD/([0-9A-Za-z_]+)$|) { my $num = $1; my $board = newBoard($num, $buf); print302("http://$ENV{HTTP_HOST}$ENV{SCRIPT_NAME}/MENU/$num"); } elsif ($path =~ m|^DELETE/([0-9A-Za-z_]+)$|) { my $file = $1; if ($ENV{REMOTE_ADDR} !~ $Shingetsu::Config::adminAddr) { print403(); exit; } else { deleteDialog($file); } } elsif ($path =~ m|^XDELETE/([0-9A-Za-z_]+)$|) { my $file = $1; if ($ENV{REMOTE_ADDR} !~ $Shingetsu::Config::adminAddr) { print403(); exit; } else { deleteFile($file); } } elsif ($path =~ m|^XDELETE/([0-9A-Za-z_]+)/([0-9]+)/([0-9A-Za-z_]+)$|) { my($file, $stamp, $id) = ($1, $2, $3); if ($ENV{REMOTE_ADDR} !~ $Shingetsu::Config::adminAddr) { print403(); exit; } else { deleteRecord($file, $stamp, $id); } } else { print404(); } #------------------------------------------------------------------# # # print CGI&HTML header # sub printHeader { my($title) = @_; my $ver = $Shingetsu::Config::version; print "Content-Type: text/html; charset=euc-jp\r\n", "Content-Language: ja\r\n", "X-Shingetsu: shinGETsu/$ver\r\n", "\r\n"; print '', '', '', '', '', '', "", "$title", "", "", ""; } # # print CGI header (403 forbidden) # sub print403 { my $ver = $Shingetsu::Config::version; print "Content-Type: text/plain\r\n", "X-Shingetsu: shinGETsu/$ver\r\n", "\r\n", "You are not the administrator.\n"; } # # print CGI header (404 not found) # sub print404 { my ($file) = @_; printHeader("404 Not Found"); print "

Bad arguments or No data.

Try later.

"; if (defined $file) { print "
", "

"; } print "\n"; } # # print CGI header (302 moved temporarily) # sub print302 { my($next) = @_; my $ver = $Shingetsu::Config::version; my($title) = @_; print "Content-Type: text/html; charset=euc-jp\r\n", "Content-Language: ja\r\n", "X-Shingetsu: shinGETsu/$ver\r\n", "\r\n"; print '', '', '', '', '', '', '', "moved", "", "", ""; print "

Click and jump to $next

\n", "", "\n"; } # # print title page # sub printTitle { printHeader("新月"); print '

新月 - P2P anonymous BBS

', "

shinGETsu is released under the GNU General Public License

\n", "", "\n"; } # # print MOTD file # sub printMotd { print "Content-type: text/plain; charset=euc-jp\r\n", "X-Shingetsu: shinGETsu/$Shingetsu::Config::version\r\n\r\n"; open IN, $Shingetsu::Config::motd; while () { print; } close IN; } # # print menu # sub printMenu { my($menu) = @_; $menu = $menufile if ($menu eq ""); local $_; touch($menu); printHeader($menu); open IN, "$datadir/$menu.dat" or die "$datadir/$menu.dat: failed to open. $!"; print "

$menu

", "
    \n"; my %exist = (); my %size = (); my %stamp = (); while () { chomp; @_ = split /<>/; next if (@_ <= 2); my $file = "$datadir/$_[2].dat"; my $buf = "
  • " . "$_[3]
    • \n"; push @buf, $buf; $exist{$buf} = (-e $file); $size{$buf} = (-s $file); $stamp{$buf} = $_[0]; } close IN; @buf = sort { if ($exist{$a} && (! $exist{$b})) { return -1; } elsif ($exist{$b} && (! $exist{$a})) { return 1; } elsif ($size{$a} && (! $size{$b})) { return -1; } elsif ($size{$b} && (! $size{$a})) { return 1; } else { return $stamp{$a} <=> $stamp{$b}; } } @buf; print @buf; print "

", "

"; my $filesize = int((-s "$datadir/$menu.dat")/1024/1024*10)/10; if ($filesize <= $Shingetsu::Config::filelimit) { print "

", " ", "", "Send to other nodes
", "Boardname:
", "Description: ", "

",; } print "
", "

", " ${filesize}MB

\n"; } # # print board # sub printBoard { my($board) = @_; local($_, @_); touch($board); open IN, "$datadir/$board.dat" or die "$datadir/$board.dat: failed to open. $!"; my @data = ; @_ = split /<>/, $data[0]; if ($_[0] =~ /^0+$/) { chomp $_[-1]; printHeader($_[2]); $_[3] = "" if (! defined $_[3]); print "

$_[2]:$_[3]

", "
    \n"; shift @data; } else { printHeader($board); print "

    $board

    ", "
      \n"; } my @buf = (); my %stamp = (); my %stat = Shingetsu::CacheStat::list(); foreach (@data) { chomp; @_ = split /<>/; next if (@_ <= 2); my $file = "$datadir/$_[2].dat"; my($stamp, $records) = ($_[0], 0); if (-f $file) { $stamp = $stat{$_[2]}{stamp}; $records = $stat{$_[2]}{records} - 1; } my $str = xlocaltime($stamp); $records = "?" if ($records <= 0); my $buf = "
    • " . "$str: $_[3]($records)
      • \n"; push @buf, $buf; $stamp{$buf} = $stamp; } close IN; @buf = sort {$stamp{$b} <=> $stamp{$a}} @buf; print @buf; print "

    MENU

    ", "

    ", "

    "; my $filesize = int((-s "$datadir/$board.dat")/1024/1024*10)/10; if ($filesize <= $Shingetsu::Config::filelimit) { print "

    ", "", " ", "Send to other nodes
    ", "Thradname: ", "

    "; } print "
    ", "

    ", " ${filesize}MB

    \n"; } # # print thread # sub printThread { my($thread) = @_; local($_, @_); touch($thread); open IN, "$datadir/$thread.dat" or die "$datadir/$thread.dat: failed to open. $!"; my @data = ; @_ = split /<>/, $data[0]; if ($_[0] =~ /^0+$/) { chomp $_[-1]; my $title = $_[2]; if (@_ >= 7) { my $x = $data[0]; my %rec = rec_thread($x); $title .= ":$rec{type}" if (defined $rec{type}); } printHeader($title); print "

    $title

    ", "
    \n"; shift @data; } else { printHeader($thread); print "

    $thread

    ", "
    \n"; } foreach (@data) { next if (/^\d+<>[0-9A-Za-z]+$/); chomp; my %rec = rec_thread($_); my $xstamp = xlocaltime $rec{stamp}; $rec{name} = "名無しさん" if ((! defined $rec{name}) || ($rec{name} eq "")); $rec{mail} = "" if (! defined $rec{mail}); $rec{body} = "" if (! defined $rec{body}); $rec{body} =~ s|(>>)([0-9A-Za-z]+)|$&|g; $rec{body} =~ s|https?://[\041-\073\075-\132\136-\177]{2,}|$&|g; $rec{body} =~ s|\[\[([\041-\073\075-\132\136-\177]+)\]\]|[[$1]]|g; $rec{body} =~ s|
    |
    |ig; my $attach = ""; my $check = ""; my $remove = ""; if ($rec{attach}) { my $size = int(length($rec{attach}) / 4 * 3 / 1024); $attach = " " . "$rec{stamp}.$rec{suffix} (${size}KB)"; } if ($rec{pubkey}) { $check = "" . Shingetsu::Signature::pubkey2trip($rec{pubkey}) . ""; } if (($rec{remove_id}) && ($rec{remove_stamp})) { my $xid = substr($rec{remove_id},0,8); $remove = "[[remove: $xid]]"; } my $xid = substr $rec{id}, 0, 8; print "
    ", "$xid :$rec{name}", " [$rec{mail}] $check $xstamp$attach
    $rec{body}
    $remove
    \n"; } close IN; print "

    MENU

    ", "

    ", "

    "; my $filesize = int((-s "$datadir/$thread.dat")/1024/1024*10)/10; my $readonly = ($ENV{REMOTE_ADDR} =~ $Shingetsu::Config::adminAddr)? "": "readonly='readonly'"; if ($filesize <= $Shingetsu::Config::filelimit) { print "

    ", "", " ", "Send to other nodes", " ", "Error in timestamp
    ", " Name: ", " E-mail: ", " Trip:
    ", " Attach: ", " Type: (limit: ${Shingetsu::Config::filelimit}MB)
    ", "", "

    "; } print "
    ", "

    ", " ${filesize}MB

    \n"; } # # print attachment # sub printAttach { my($thread, $id, $stamp, $suffix) = @_; my $ver = $Shingetsu::Config::version; $suffix = lc $suffix; my $type = $Shingetsu::Config::mimeType{$suffix}; $type = "text/plain" unless (defined $type); touch($thread); open IN, "$datadir/$thread.dat" or die "$datadir/$thread.dat: failed to open. $!"; my $value; while () { chomp; local @_ = split /<>/, $_; if ((@_ >= 7) && ($_[0] eq $stamp) && ($_[1] eq $id)) { $value = $_[6]; last; } } close IN; if (defined $value) { print "Content-Type: $type\r\n", "X-Shingetsu: shinGETsu/$ver\r\n", "\r\n", Shingetsu::Extern::base64decode($value); } else { print404($thread); } } # # check signature # sub checkSign { my %arg = args($ENV{QUERY_STRING}); unless ($arg{file} && $arg{stamp} && $arg{id}) { print404(); exit; } my $file = $arg{file}; touch($file); open IN, "$datadir/$file.dat" or die "$datadir/$file.dat: failed to open. $!"; my $value; while () { chomp; my %rec = rec_thread($_); next unless (($rec{stamp} eq $arg{stamp}) && ($rec{id} eq $arg{id})); if (! ((defined $rec{pubkey}) && ($rec{pubkey} ne "") && (defined $rec{sign}) && ($rec{sign} ne ""))) { print "Content-Type: text/plain; charset=euc-jp\r\n", "X-Shingetsu: shinGETsu/$Shingetsu::Config::version\r\n", "\r\n", "This record is not signed.\n$_\n"; } elsif (check_traditional_signature(%rec)) { s//>/g; my $trip = Shingetsu::Signature::pubkey2trip($rec{pubkey}); my($type, $filename) = split /_/, $file, 2; printHeader("check sign"); print "

    This record is protected(traditional).

    ", # "

    ", # "", # "/", # "", # "", # "", # "this trip to/from trust list: $trip

    ", "

    $_

    ", ""; close IN; exit; } else { print "Content-Type: text/plain; charset=euc-jp\r\n", "X-Shingetsu: shinGETsu/$Shingetsu::Config::version\r\n", "\r\n", "This record has WRONG sign.\n$_\n"; close IN; exit; } } close IN; print404($file); } # # make file # sub touch { my($file) = @_; my %stat = Shingetsu::CacheStat::list(); unless (-s "$datadir/$file.dat") { Shingetsu::Util::lock(); open OUT, ">> $datadir/$file.dat"; close OUT; Shingetsu::Util::unlock(); } if ((-s "$datadir/$file.dat") == 0) { my $node = Shingetsu::Cache::search($file); if (defined $node) { Shingetsu::Cache::getRegion($file, $node); } } if (-z "$datadir/$file.dat") { print404($file); exit; } } # # escape # sub escape { local($_) = @_; s/&/&/g; s/&(#\d+|#[Xx][0-9A-Fa-f]+|[A-Za-z0-9]+);/&$1;/g; s/"/"/g; s//>/g; s/\r//g; s/\n/
    /g; return $_; } # # unescape arguments # sub args { local $_ = $_[0]; local @_ = split /&/; my %arg = (); foreach (@_) { local @_ = split /=/; if (defined $_[1]) { $_[1] =~ s/\+/ /g; $_[1] =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg; $arg{$_[0]} = escape($_[1]); } else { $arg{$_[0]} = ""; } } return %arg; } # # unescape arguments(multipart/form-data) # sub argsFromMulti { my($input) = @_; local $_; my %arg = (); $input =~ /\s/; my $boundary = $`; my @input = split $boundary, $input; shift @input; foreach (@input) { my @buf = split /\r\n/, $_; next if (@buf == 1); shift @buf; $buf[0] =~ /Content-Disposition: form-data; name="([^"]+)"/i or next; my $key = $1; if ($buf[0] =~ /filename="([^"]+)"/i) { $arg{auto_suffix} = $1; $arg{auto_suffix} =~ s/.*[\/\\]//; if ($arg{auto_suffix} =~ /\.([^.]*)$/) { $arg{auto_suffix} = $1; $arg{auto_suffix} = lc $arg{auto_suffix}; } else { $arg{auto_suffix} = ""; } } $_ = shift @buf until ((! defined $_) || ($_ eq "")); $arg{$key} = join "\r\n", @buf; if ($key ne "attach") { $arg{$key} = escape($arg{$key}); } } return %arg; } # # post article # sub post { my($thread, $input) = @_; local $_; my %arg = argsFromMulti($input); my ($suffix, $attach) = ("", ""); $arg{name} = "" unless (defined $arg{name}); $arg{mail} = "" unless (defined $arg{mail}); if ((defined $arg{attach}) && ($arg{attach} ne "")) { xdie "Too big file" if (length $arg{attach} > $Shingetsu::Config::filelimit*1024*1024); $attach = Shingetsu::Extern::base64encode($arg{attach}); if ($arg{suffix} ne "AUTO") { $suffix = $arg{suffix}; } elsif ((defined $arg{auto_suffix}) && ($arg{auto_suffix} ne "")) { $suffix = $arg{auto_suffix}; } else { $suffix = "txt"; } } my $stamp = (defined $arg{error})? Shingetsu::Util::time(): time; my $body = "$arg{name}<>$arg{mail}<>$arg{message}<>$suffix<>$attach"; if ($arg{passwd} ne "") { my($pubkey, $sign) = generate_traditional_signature($arg{passwd}, $body); $body .= "<>pubkey:$pubkey<>sign:$sign" } my $id = addRecord($thread, $stamp, $body); if (defined $arg{dopost}) { Shingetsu::Util::addUpdate($stamp, $id, $thread); Shingetsu::Cache::tellupdate($thread, $stamp, $id, undef); } return substr $id, 0, 8; } # # make new thread # sub newThread { my($board, $input) = @_; local $_; my %arg = args($input); my $stamp = Shingetsu::Util::time(); xdie "Null Thread Name" if ($arg{thradname} eq ""); my @ary = (0..9, 'A'..'Z', 'a'..'z'); my $nop = ""; $nop .= $ary[rand(0+@ary)] foreach (1..16); my $body2 = "$arg{thradname}<><><><><>nop:$nop"; my $thread = Shingetsu::Extern::md5digest($body2); my $body = "$thread<>$arg{thradname}<><><>"; my $id = addRecord($board, $stamp, $body); newFile($thread, "0000000000", 0, $body2); if (defined $arg{dopost}) { Shingetsu::Util::addUpdate($stamp, $id, $board); Shingetsu::Cache::tellupdate($board, $stamp, $id, undef); } return $thread; } # # make new board # sub newBoard { my($menu, $input) = @_; local $_; my %arg = args($input); my $stamp = Shingetsu::Util::time(); my @ary = (0..9, 'A'..'Z', 'a'..'z'); my $nop = ""; xdie "Null Board Name" if ($arg{boardname} eq ""); xdie "Null Description" if ($arg{comment} eq ""); $nop .= $ary[rand(0+@ary)] foreach (1..16); my $body2 = "$arg{boardname}<>$arg{comment}<><><><>nop:$nop"; my $board = Shingetsu::Extern::md5digest($body2); my $body = "$board<>$arg{boardname}<><><>"; my $id = addRecord($menu, $stamp, $body); newFile($board, "0000000000", 0, $body2); if (defined $arg{dopost}) { Shingetsu::Util::addUpdate($stamp, $id, $menu); Shingetsu::Cache::tellupdate($menu, $stamp, $id, undef); } return $board; } # # delete dialog # sub deleteDialog { my($file) = @_; my %arg = args($ENV{QUERY_STRING}); local $_; if (defined $arg{record}) { printHeader("delete record"); print "

    delete record

    \n"; my($stamp, $id) = split /\//, $arg{record}; my $buf; if (open IN, "$datadir/$file.dat") { while () { if (/$stamp<>$id<>/) { $buf = $_; last; } } close IN; if (defined $buf) { $buf =~ s//>/g; print "

    Do you delete following record? ", "", "YES

    \n", "

    $buf

    \n"; } else { print "

    no such record

    \n"; } } else { print "

    $file: no such file

    \n"; } } else { printHeader("delete file"); print "

    delete file

    \n"; my @buf = (); my $count = 0; if (open IN, "$datadir/$file.dat") { while () { push @buf, $_; last if ($count++ > 1); } close IN; print "

    Do you delete following file? ", "", "YES

    \n"; foreach (@buf) { chomp; s//>/g; print "

    $_

    \n"; } print "\n"; } else { print "

    $file: no such file

    \n"; } } } # # delete file # sub deleteFile { my($file) = @_; if (unlink "$datadir/$file.dat") { my %stat = Shingetsu::CacheStat::list(); delete $stat{$file}; Shingetsu::CacheStat::sync(%stat); print302("http://$ENV{HTTP_HOST}$ENV{SCRIPT_NAME}/MENU"); } else { print "Content-Type: text/plain\r\n\r\n", "failed. $!\n"; } } # # delete record # sub deleteRecord { my($file, $stamp, $id) = @_; my %arg = args($ENV{QUERY_STRING}); if (! Shingetsu::Cache::removeRecord($file, $stamp, $id)) { print "Content-Type: text/plain\r\n\r\n", "failed. $!\n"; } elsif ((defined $arg{mode}) && ($arg{mode} ne "")) { print302("http://$ENV{HTTP_HOST}$ENV{SCRIPT_NAME}/$arg{mode}/$file"); } else { print "Content-Type: text/plain\r\n\r\n", "succeed. $!\n"; } } # # add record # sub addRecord { my($file, $stamp, $body) = @_; my $id = Shingetsu::Extern::md5digest($body); Shingetsu::Util::lock(); open OUT, ">> $datadir/$file.dat" or die "$datadir/$file.dat: failed to open. $!"; print OUT "$stamp<>$id<>$body\n"; close OUT; Shingetsu::Util::unlock(); my %stat = Shingetsu::CacheStat::list(); $stat{$file}{records}++; $stat{$file}{stamp} = $stamp; Shingetsu::CacheStat::sync(%stat); return $id; } # # new file # sub newFile { my($file, $stamp, $body) = @_; my $id = Shingetsu::Extern::md5digest($body); xdie "File Exist" if (-e "$datadir/$file.dat"); Shingetsu::Util::lock(); open OUT, ">> $datadir/$file.dat.new" or die "$datadir/$file.dat.new: failed to open. $!"; print OUT "$stamp<>$id<>$body\n"; close OUT; Shingetsu::Util::unlock(); return $id; }