Wapp

Check-in [cfa2467c17]
Login

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Fix the multipart/form-data parser so that it can accept none-file uploads. Add the "fileupload.tcl" example.
Downloads: Tarball | ZIP archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA3-256: cfa2467c173500071c1935f8a863f9da5df4fad7ebd8e0e1132202e3d1876976
User & Date: drh 2019-03-04 19:18:37.614
Context
2019-03-06
17:44
Update the fileupload.tcl example so that uploaded images are shown in-line. This demonstrates how to use the TCL "binary encode" command to generate base64 from the raw image content and how to modify content-security-policy to allow "data:" sources for images. (check-in: af9968656c user: drh tags: trunk)
2019-03-04
19:18
Fix the multipart/form-data parser so that it can accept none-file uploads. Add the "fileupload.tcl" example. (check-in: cfa2467c17 user: drh tags: trunk)
2019-02-16
12:07
Minor updates to the documentation. (check-in: ca3221ef4e user: drh tags: trunk)
Changes
Unified Diff Ignore Whitespace Patch
Added examples/fileupload.tcl. 
























































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75

#!/usr/bin/wapptclsh
#
# This script demonstrates a Wapp application that can accept a file
# upload using <input type="file">
#
package require wapp
proc common-header {} {
  wapp-trim {
    <html>
    <head>
    <meta name="viewport" content="width=device-width, initial-scale=1.0">
    <meta http-equiv="content-type" content="text/html; charset=UTF-8">
    <link href="%url([wapp-param SCRIPT_NAME]/style.css)" rel="stylesheet">
    <title>Wapp File-Upload Demo</title>
    </head>
    <body>
  }
}
proc common-footer {} {
  wapp-trim {
    </body>
    </html>
  }
}
proc wapp-default {} {
  wapp-cache-control max-age=3600
  common-header
  wapp-trim {
    <h1>Wapp File-Upload Demo</h1>
  }
  # NB:  You must set enctype="multipart/form-data" on your <form> in order
  # for file upload to work.
  wapp-trim {
    <p><form method="POST" enctype="multipart/form-data">
    File To Upload: <input type="file" name="file"><br>
    <input type="checkbox" name="showenv" value="1">Show CGI Environment<br>
    <input type="submit" value="Submit">
    </form></p>
  }
  # Ordinary query parameters come through just like normal
  if {[wapp-param showenv 0]} {
    wapp-trim {
      <h1>Wapp Environment</h1>
      <pre>%html([wapp-debug-env])</pre>
    }
  }
  # File upload query parameters come in three parts:  The *.mimetype,
  # the *.filename, and the *.content.
  set mimetype [wapp-param file.mimetype {}]
  set filename [wapp-param file.filename {}]
  set content [wapp-param file.content {}]
  if {$filename!=""} {
    wapp-trim {
      <h1>Uploaded File Content</h1>
      <p>Filename: %html($filename)<br>
      MIME-Type: %html($mimetype)<br>
      Content:</p>
      <blockquote><pre>
      %html($content)
      </pre></blockquote>
    }
  }
  common-footer
}
proc wapp-page-style.css {} {
  wapp-mimetype text/css
  wapp-cache-control max-age=3600
  wapp-trim {
    pre {
       border: 1px solid black;
       padding: 1ex;
    }
  }
}
wapp-start $argv
Changes to wapp.tcl.
︙︙
550
551
552
553
554
555
556
557
558
559
560
561
562
563



564
565
566
567
568
569
570

      regexp {^(.*?)\r\n(.*)$} [dict get $wapp CONTENT] all divider body
      set ndiv [string length $divider]
      while {[string length $body]} {
        set idx [string first $divider $body]
        set unit [string range $body 0 [expr {$idx-3}]]
        set body [string range $body [expr {$idx+$ndiv+2}] end]
        if {[regexp {^Content-Disposition: form-data; (.*?)\r\n\r\n(.*)$} \
             $unit unit hdr content] &&
            [regexp {name="(.*)"; filename="(.*)"\r\nContent-Type: (.*?)$}\
              $hdr hr name filename mimetype]} {
          dict set wapp $name.filename \
            [string map [list \\\" \" \\\\ \\] $filename]
          dict set wapp $name.mimetype $mimetype
          dict set wapp $name.content $content



        }
      }
    }
  }
}

# Invoke application-supplied methods to generate a reply to








|
|
|
|
|
|
|
>
>
>








550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573

      regexp {^(.*?)\r\n(.*)$} [dict get $wapp CONTENT] all divider body
      set ndiv [string length $divider]
      while {[string length $body]} {
        set idx [string first $divider $body]
        set unit [string range $body 0 [expr {$idx-3}]]
        set body [string range $body [expr {$idx+$ndiv+2}] end]
        if {[regexp {^Content-Disposition: form-data; (.*?)\r\n\r\n(.*)$} \
             $unit unit hdr content]} {
          if {[regexp {name="(.*)"; filename="(.*)"\r\nContent-Type: (.*?)$}\
                $hdr hr name filename mimetype]} {
            dict set wapp $name.filename \
              [string map [list \\\" \" \\\\ \\] $filename]
            dict set wapp $name.mimetype $mimetype
            dict set wapp $name.content $content
          } elseif {[regexp {name="(.*)"} $hdr hr name]} {
            dict set wapp $name $content
          }
        }
      }
    }
  }
}

# Invoke application-supplied methods to generate a reply to
︙︙