1#!/usr/bin/perl
2
3=pod
4
5primary key is in $in{'pk'}
6FILE ITSELF is in the data somehow
7
8Then we offer a variety of links to go to next -- enterimage for
9all entries with a text entry but no photo entry?
10
11=cut
12
13sub mydie($){
14	print <<"BLAM";
15<hr>
16<b>Error</b> $_[0]
17BLAM
18
19exit
20}
21flock LOG,LOCK_EX;
22seek(LOG,0,2);
23print LOG
24scalar(localtime)," $ENV{'REMOTE_ADDR'} $0 $$;$S\n";
25
26print <<"FOO";
27Content-Type: text/html
28
29FOO
30
31foreach $C (split(';',$ENV{'HTTP_COOKIE'})){
32        $C =~ m/^(\w+)=(.*)$/ and $Cookies{$1} = $2;
33};
34
35&ReadParsearoni;
36
37=pod
38 $in{'filename'} is the file name.
39
40while(my ($k,$v) = each %in){
41	print "$k --> $v <hr>\n";
42};
43=cut
44
45# adjust path to your xlhtml executable in the next line
46print `/opt/bin/xlhtml -a $in{'filename'}`;
47unlink $in{'filename'};  # comment out to keep uploaded files
48
49
50exit;
51
52sub PrintForm(){
53print <<FORM;
54
55<html><head>
56<title>Excel Spreadsheet Converter</title></head>
57<body>
58<br>
59<form method=post enctype="multipart/form-data" action="uploader.pl">
60<TABLE><TR>
61<TD>What Excel file to display?</TD>
62<TD><INPUT TYPE="file" SIZE=40 NAME="filename"></TD>
63</TR>
64<TR><TD>&nbsp;</TD><TD>&nbsp;</TD></TR>
65<TR><TD>&nbsp;</TD>
66<TD align="center"><INPUT TYPE="submit" VALUE="upload"></TD>
67</TR></TABLE>
68</form></body></html>
69
70
71FORM
72
73exit;
74};
75
76=pod
77
78file uploading code ripped from
79
80# Perl Routines to Manipulate CGI input
81# cgi-lib@pobox.com
82# $Id: uploader.pl,v 1.1.1.1 2002/03/20 15:33:03 slidedraw Exp $
83#
84# Copyright (c) 1993-1998 Steven E. Brenner
85# For more information, see:
86#     http://cgi-lib.stanford.edu/cgi-lib/
87
88and modified heavily.
89(david nicol davidnicol@acm.org 02/22/1999)
90
91and yet again
92(david nicol davidnicol@acm.org 09/27/1999)
93
94=cut
95
96sub ReadParsearoni {
97
98# Parameters affecting cgi-lib behavior
99# User-configurable parameters affecting file upload.
100
101# Do not change the following parameters unless you have special reasons
102$cgi_lib'bufsize  =  8192;    # default buffer size when reading multipart
103$cgi_lib'maxbound =   100;    # maximum boundary length to be encounterd
104
105
106	# Get several useful env variables
107  $type = $ENV{'CONTENT_TYPE'};
108  $len  = $ENV{'CONTENT_LENGTH'};
109  $meth = $ENV{'REQUEST_METHOD'};
110  $maxdata    = 131072;    # maximum bytes to accept via POST - 2^17
111
112  if ($len > $maxdata) {
113      mydie "Excel file is too large, at $len. The maximum size permitted is $maxdata";
114  }
115
116  unless ($ENV{'CONTENT_TYPE'} =~ m#^multipart/form-data#) {
117	# mydie "expecting multipart/form-data to upload an Excel Spreadsheet";
118	PrintForm;
119  };
120
121    local ($buf, $boundary, $head, @heads, $cd, $ct, $fname, $ctype, $blen);
122    local ($bpos, $lpos, $left, $amt, $fn, $ser);
123    local ($bufsize, $maxbound) =
124      ($cgi_lib'bufsize, $cgi_lib'maxbound);
125
126
127    # The following lines exist solely to eliminate spurious warning messages
128    $buf = '';
129
130    ($boundary) = $type =~ /boundary="([^"]+)"/; #";   # find boundary
131    ($boundary) = $type =~ /boundary=(\S+)/ unless $boundary;
132    mydie ("Boundary not provided: probably a bug in your server")
133      unless $boundary;
134    $boundary =  "--" . $boundary;
135    $blen = length ($boundary);
136
137    if ($ENV{'REQUEST_METHOD'} ne 'POST') {
138      mydie("Invalid request method for  multipart/form-data: $meth\n");
139    }
140
141    $writefiles = './tempdata/';
142    stat ($writefiles);
143    mydie "Cannot write to directory $writefiles" unless  -d _ && -w _;
144
145    # read in the data and split into parts:
146    # put headers in @in and data in %in
147    # General algorithm:
148    #   There are two dividers: the border and the '\r\n\r\n' between
149    # header and body.  Iterate between searching for these
150    #   Retain a buffer of size(bufsize+maxbound); the latter part is
151    # to ensure that dividers don't get lost by wrapping between two bufs
152    #   Look for a divider in the current batch.  If not found, then
153    # save all of bufsize, move the maxbound extra buffer to the front of
154    # the buffer, and read in a new bufsize bytes.  If a divider is found,
155    # save everything up to the divider.  Then empty the buffer of everything
156    # up to the end of the divider.  Refill buffer to bufsize+maxbound
157    #   Note slightly odd organization.  Code before BODY: really goes with
158    # code following HEAD:, but is put first to 'pre-fill' buffers.  BODY:
159    # is placed before HEAD: because we first need to discard any 'preface,'
160    # which would be analagous to a body without a preceeding head.
161
162    $left = $len;
163   PART: # find each part of the multi-part while reading data
164    while (1) {
165      die $@ if $errflag;
166
167      $amt = ($left > $bufsize+$maxbound-length($buf)
168	      ?  $bufsize+$maxbound-length($buf): $left);
169      $errflag = (($got = read(STDIN, $buf, $amt, length($buf))) != $amt);
170      mydie "Short Read: wanted $amt, got $got\n" if $errflag;
171      $left -= $amt;
172
173      $in{$name} .= "\0" if defined $in{$name};
174      $in{$name} .= $fn if $fn;
175
176      $name=~/([-\w]+)/;  # This allows $insfn{$name} to be untainted
177      if (defined $1) {
178        $insfn{$1} .= "\0" if defined $insfn{$1};
179        $insfn{$1} .= $fn if $fn;
180      }
181
182     BODY:
183      while (($bpos = index($buf, $boundary)) == -1) {
184        if ($left == 0 && $buf eq '') {
185	  foreach $value (values %insfn) {
186            unlink(split("\0",$value));
187	  }
188	  mydie("cgi-lib.pl: reached end of input while seeking boundary " .
189		  "of multipart. Format of CGI input is wrong.\n");
190        }
191        die $@ if $errflag;
192        if ($name) {  # if no $name, then it's the prologue -- discard
193          if ($fn) { print FILE substr($buf, 0, $bufsize); }
194          else     { $in{$name} .= substr($buf, 0, $bufsize); }
195        }
196        $buf = substr($buf, $bufsize);
197        $amt = ($left > $bufsize ? $bufsize : $left); #$maxbound==length($buf);
198        $errflag = (($got = read(STDIN, $buf, $amt, length($buf))) != $amt);
199	die "Short Read: wanted $amt, got $got\n" if $errflag;
200        $left -= $amt;
201      }
202      if (defined $name) {  # if no $name, then it's the prologue -- discard
203        if ($fn) { print FILE substr($buf, 0, $bpos-2); }
204        else     { $in {$name} .= substr($buf, 0, $bpos-2); } # kill last \r\n
205      }
206      close (FILE);
207      last PART if substr($buf, $bpos + $blen, 2) eq "--";
208      substr($buf, 0, $bpos+$blen+2) = '';
209      $amt = ($left > $bufsize+$maxbound-length($buf)
210	      ? $bufsize+$maxbound-length($buf) : $left);
211      $errflag = (($got = read(STDIN, $buf, $amt, length($buf))) != $amt);
212      die "Short Read: wanted $amt, got $got\n" if $errflag;
213      $left -= $amt;
214
215
216      undef $head;  undef $fn;
217     HEAD:
218      while (($lpos = index($buf, "\r\n\r\n")) == -1) {
219        if ($left == 0  && $buf eq '') {
220	  foreach $value (values %insfn) {
221            unlink(split("\0",$value));
222	  }
223	  mydie("cgi-lib: reached end of input while seeking end of " .
224		  "headers. Format of CGI input is wrong.\n$buf");
225        }
226        die $@ if $errflag;
227        $head .= substr($buf, 0, $bufsize);
228        $buf = substr($buf, $bufsize);
229        $amt = ($left > $bufsize ? $bufsize : $left); #$maxbound==length($buf);
230        $errflag = (($got = read(STDIN, $buf, $amt, length($buf))) != $amt);
231        die "Short Read: wanted $amt, got $got\n" if $errflag;
232        $left -= $amt;
233      }
234      $head .= substr($buf, 0, $lpos+2);
235      push (@in, $head);
236      @heads = split("\r\n", $head);
237      ($cd) = grep (/^\s*Content-Disposition:/i, @heads);
238      ($ct) = grep (/^\s*Content-Type:/i, @heads);
239
240      ($name) = $cd =~ /\bname="([^"]+)"/i; #";
241      ($name) = $cd =~ /\bname=([^\s:;]+)/i unless defined $name;
242
243      ($fname) = $cd =~ /\bfilename="([^"]*)"/i; #"; # filename can be null-str
244      ($fname) = $cd =~ /\bfilename=([^\s:;]+)/i unless defined $fname;
245      $incfn{$name} .= (defined $in{$name} ? "\0" : "") .
246        (defined $fname ? $fname : "");
247
248      ($ctype) = $ct =~ /^\s*Content-type:\s*"([^"]+)"/i;  #";
249      ($ctype) = $ct =~ /^\s*Content-Type:\s*([^\s:;]+)/i unless defined $ctype;
250      $inct{$name} .= (defined $in{$name} ? "\0" : "") . $ctype;
251
252	$fn = $writefiles."temp$$"."a";
253	while (-e $fn){ $fn++ };
254	open (FILE, ">$fn") || mydie("Couldn't open $fn $!\n");
255	#print "Wanting to write " and mydie("Couldn't open $fn $!\n");
256      substr($buf, 0, $lpos+4) = '';
257      undef $fname;
258      undef $ctype;
259    }
260
261    if ($errflag) {
262      local ($errmsg, $value);
263      $errmsg = $@ || $errflag;
264      foreach $value (values %insfn) {
265        unlink(split("\0",$value));
266      }
267      mydie($errmsg);
268    } else {
269      # everything's ok.
270    }
271  }
272
273
274
275