examples/upload.cgi

   1 #!/usr/bin/newlisp
   2 #
   3 # Upload script v. 1.0
   4 # v 1.1 - changed 'integer' to 'int'
   5 #
   6 # serves POST request from upload.html
   7 #
   8 #
   9
  10 (define (process-upload,
  11                 ; locals
  12                 len type infile outfile boundary
  13                 disposition filename start end size
  14                 bytesread buffer)
  15
  16         (print "Content-type: text/html\n\n")
  17
  18         ; check for valid request header
  19         (set 'len (int (env "CONTENT_LENGTH") 0))
  20         (set 'type (env "CONTENT_TYPE"))
  21         (if (not (find ".*multipart/form-data;.*boundary=.*" type 1))
  22               (throw-error "wrong upload format"))
  23
  24         ; read data into intermediate file
  25         (set 'infile (open "upload-file" "write"))
  26         (while (!= (read-buffer (device) 'buffer 1024) 0)
  27             (write-buffer infile buffer))
  28         (close infile)
  29
  30         ; get filename and boundaries
  31         (set 'infile (open "upload-file" "read"))
  32         (set 'boundary (read-line infile)) ; get boundary string
  33         (set 'disposition (read-line infile))
  34
  35         (if (not (find ".*filename=\"(.*)\".*" disposition 1))
  36                 (throw-error "wrong upload format"))
  37         (if (= "" (set 'filename $1))
  38                 (throw-error "need file name")
  39                 (set 'filename (last (parse filename "/|\\\\" 0))))
  40
  41         ; read from intermedeate file into permanent file
  42         (while (!= "" (read-line infile)))
  43         (set 'start (seek infile))
  44         (set 'end (search infile boundary))
  45         (set 'size (- end start 2))
  46
  47         (set 'outfile (open filename "write"))
  48         (seek infile start)
  49         (while (> size 0)
  50             (set 'bytesread (read-buffer infile 'buffer (min 1024 size)))
  51             (write-buffer outfile 'buffer bytesread)
  52             (dec 'size bytesread))
  53         (close infile)
  54         (close outfile)
  55         (delete-file "upload-file"))
  56
  57 (if (not (catch (process-upload) 'result))
  58         (print "<h2>" (first (parse result "\\r\\n|\\n" 0)) "</h2>")
  59         (print {<h2>file uploaded, click <a href="upload.html">continue</a></h2>}))
  60
  61 (exit)