#!/usr/local/bin/perl

#======================================================================
# Name:     WWWUPL
# Version:  Ver2.13
# Category: t[\tgigpEEĔzzRj
# Contact:  http://tohoho.wakusei.ne.jp/
# Copyrignt (C) 1997-2004 mX
#======================================================================

#
# gp@
#
# (1) ʏCGIƂĐݒuĂB(CGIݒu̒mKvƂ܂)
# (2) wwwupl.cgiׂ̗wwwuplfBNg($upload_dirŕύX\)쐬
#     ĂBwwwuplfBNǵAWEBT[o[߂悤
#     Ȍ(p[~bV)ݒ肵ĂB
# (3) HTMLt@Cȉ̂悤ɌĂяoĂB
#      <FORM METHOD=POST ENCTYPE="multipart/form-data" ACTION="wwwupl.cgi">
#      <INPUT TYPE=file NAME="AAA"><BR>
#      <INPUT TYPE=file NAME="BBB"><BR>   ȗ
#      <INPUT TYPE=submit VALUE="M">
#      </FORM>
# (4) Abv[hꂽt@ĆAwwwuplfBNgɁA$append_suffix
#     Ŏw肵gqtŕۑ܂B$append_suffix""ɂƁA
#     {҂ .cgi  .shtml ̃t@C쐬łĂ܂̂ŁA
#     ZLeBɂ͏[ӂĂB
# (5) ǂݍ񂾃f[^ׂāAAobt@ɓǂݍނ̂ŁA܂傫
#     t@C͓]łȂ܂B
# (6) 16ȏ㓯ɃAbv[h邱Ƃ͂ł܂B
#
# 
#  1999/02/07 Ver2.00 
#  1999/02/14 Ver2.01 \r\n܂ރoCiMsoOC
#  1999/04/25 Ver2.02 t@C󗓎Aform-data.uplłoOC
#  1999/04/25 Ver2.10 TYPE=textȂǂ̃f[^Mł悤ɂ
#  1999/06/02 Ver2.11 muleperl-modeΉ /(...$)/ -> /(...)$/
#  2001/05/09 Ver2.12 ̕ύXȂ
#  2004/04/04 Ver2.13 ʐMG[ɖ[v̉\C

# JX^}CYp[^
$upload_dir = "wwwupl";  # Abv[ht@Ci[fBNg
$append_suffix = ".upl"; # t@Cɒǉgq

# y[Wwb_o
print "Content-type: text/html\n";
print "\n";
print "<html>\n";
print "<head>\n";
print "<title>t@CAbv[h</title>\n";
print "</head>\n";
print "<body>\n";
print "<h2>t@CAbv[h</h2>\n";
print "<hr>\n";
print "<p>L̃t@C󂯎܂B</p>\n";
print "<ul>\n";

# W͂f[^ǂ݂
$buf = "";
$read_data = "";
$remain = $ENV{'CONTENT_LENGTH'};
binmode(STDIN);
while ($remain) {
  $len = sysread(STDIN, $buf, $remain);
  if (!$len) {
    last;
  }
  $remain -= $len;
  $read_data .= $buf;
}

# f[^߂
$pos1 = 0; # wb_̐擪
$pos2 = 0; # {fB̐擪
$pos3 = 0; # {fB̏I[
$delimiter = "";
$max_count = 0;
while (1) {

  # wb_
  $pos2 = index($read_data, "\r\n\r\n", $pos1) + 4;
  @headers = split("\r\n", substr($read_data, $pos1, $pos2 - $pos1));
  $filename = "";
  $name = "";
  foreach (@headers) {
    if ($delimiter eq "") {
      $delimiter = $_;
    } elsif (/^Content-Disposition: ([^;]*); name="([^;]*)"; filename="([^;]*)"/i) {
      if ($3) {
        $filename = $3;
        if ($filename =~ /([^\\\/]+)$/) {
          $filename = $1;
        }
      }
    } elsif (/^Content-Disposition: ([^;]*); name="([^;]*)"/i) {
      $name = $2;
    }
  }

  # {fB
  $pos3 = index($read_data, "\r\n$delimiter", $pos2);
  $size = $pos3 - $pos2;
  if ($filename) {
    print "<li>FILE: " . html($filename) . "($size Byte)\n";
    if (open(OUT, "> $upload_dir/$filename$append_suffix")) {
      binmode(OUT);
      print OUT substr($read_data, $pos2, $size);
      close(OUT);
    }
  } elsif ($name) {
    $FORM{$name} = substr($read_data, $pos2, $size);
    print "<li>DATA: $name=" . html($FORM{$name}) . "\n";
  }

  # I
  $pos1 = $pos3 + length("\r\n$delimiter");
  if (substr($read_data, $pos1, 4) eq "--\r\n") {
    # ׂẴt@C̏I[
    last;
  } else {
    # ̃t@Cǂݏo
    $pos1 += 2;
    if ($max_count++ > 16) { last; }
    next;
  }
}

# y[Wtb^o
print "</ul>\n";
print "<hr>\n";
print "<div><a href=\"$ENV{'HTTP_REFERER'}\">[߂]</a></div>\n";
print "</body>\n";
print "</html>\n";

sub html {
  local($msg) = @_;
  $msg =~ s/&/&amp;/g;
  $msg =~ s/</&lt;/g;
  $msg =~ s/>/&gt;/g;
  return $msg;
}
