Wapp

Changes On Branch omit-cr
Login

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

Changes In Branch omit-cr Excluding Merge-Ins

This is equivalent to a diff from 199a1a71c1 to 293f95b663

2024-10-14
11:16
Do not require CRLF endings from clients. (check-in: 2b091c8428 user: drh tags: trunk)
2024-10-13
19:20
The line-ending is always a bare U+000a character only. Wapp no longer sends CRLF line endings. (Leaf check-in: 293f95b663 user: drh tags: omit-cr)
2024-09-29
22:40
Fix is so that it runs with Tcl9. (check-in: 199a1a71c1 user: drh tags: trunk)
22:03
Update the built-in SQLite to the latest 3.47.0 alpha. (check-in: 0819ed51b3 user: drh tags: trunk)

Changes to README.md.
24
25
26
27
28
29
30

31
32
33
34
35
36
37
  *  [URL Mapping](/doc/trunk/docs/urlmapping.md)
  *  [Security Features](/doc/trunk/docs/security.md)
  *  [How To Compile wapptclsh - Or Not](/doc/trunk/docs/compiling.md)
  *  [Limitations of Wapp](/doc/trunk/docs/limitations.md)
  *  [Example Applications](/file/examples)
  *  [Real-World Uses Of Wapp](/doc/trunk/docs/usageexamples.md)
  *  [Debugging Hints](/doc/trunk/docs/debughints.md)


Simple Live Demos
-----------------

  *  <https://wapp.tcl.tk/demo/>

Downloads







>







24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
  *  [URL Mapping](/doc/trunk/docs/urlmapping.md)
  *  [Security Features](/doc/trunk/docs/security.md)
  *  [How To Compile wapptclsh - Or Not](/doc/trunk/docs/compiling.md)
  *  [Limitations of Wapp](/doc/trunk/docs/limitations.md)
  *  [Example Applications](/file/examples)
  *  [Real-World Uses Of Wapp](/doc/trunk/docs/usageexamples.md)
  *  [Debugging Hints](/doc/trunk/docs/debughints.md)
  *  [Wapp does not send unnecesary CRs](/doc/trunk/docs/crlf.md)

Simple Live Demos
-----------------

  *  <https://wapp.tcl.tk/demo/>

Downloads
Added docs/crlf.md.
















































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Wapp Does Not Send CRLF
=======================

Wapp uses \\n line endings, not \\r\\n.  This is deliberate and in blatant
defiance of RFC-2616.  The lead developer of Wapp believes that that CRLF
line endings are a harmful anachronism and need to be abolished.

Even though RFC-2616 requires CRLF line endings, it does recommend that clients
also accept \\n line endings.  All known HTTP clients abide by this recommendation, and
so Wapp's refusal to play by the rules is harmless.  And it reduces bandwidth
slightly.  It is a good thing.  The omission of unnecessary \\r characters is
a feature of Wapp, not a bug.

~~~ pikchr
sin45 = sin(3.141592653/4)
C:  circle "CRLF" big big bold thick fit
C2: circle thick thick radius C.radius at C.c color red
    line thick thick from (C.x-sin45*C.radius,C.y-sin45*C.radius) \
                 to (C.x+sin45*C.radius,C.y+sin45*C.radius) color red
T1: text "CRLF-free" bold fit with .s at 1mm above C.n
T2: text "Zone" bold fit with .n at 1mm below C.s
    box ht dist(T1.s,T2.n)+lineht*1.2 wid C2.width+lineht*0.5 \
       fill yellow thick thick radius 3mm at C.c behind C
~~~
Changes to wapp.tcl.
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
        set qsplit [split $qterm =]
        set nm [lindex $qsplit 0]
        if {[regexp {^[a-z][-a-z0-9_]*$} $nm]} {
          dict set wapp $nm [wappInt-decode-url [lindex $qsplit 1]]
        }
      }
    } elseif {[string match multipart/form-data* $ctype]} {
      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]
              && [regexp {^[a-z][a-z0-9]*$} $name]} {
            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]







|





|

|







586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
        set qsplit [split $qterm =]
        set nm [lindex $qsplit 0]
        if {[regexp {^[a-z][-a-z0-9_]*$} $nm]} {
          dict set wapp $nm [wappInt-decode-url [lindex $qsplit 1]]
        }
      }
    } elseif {[string match multipart/form-data* $ctype]} {
      regexp {^(.*?)\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; (.*?)\n\r?\n(.*)$} \
             $unit unit hdr content]} {
          if {[regexp {name="(.*)"; filename="(.*)"\r?\nContent-Type: (.*?)$}\
                $hdr hr name filename mimetype]
              && [regexp {^[a-z][a-z0-9]*$} $name]} {
            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]
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
  set rc [dict get $wapp .reply-code]
  if {$rc=="ABORT"} {
    # If the page handler invokes "wapp-reply-code ABORT" then close the
    # TCP/IP connection without sending any reply
    wappInt-close-channel $chan
    return
  } elseif {$chan=="stdout"} {
    puts $chan "Status: $rc\r"
  } else {
    puts $chan "HTTP/1.1 $rc\r"
    puts $chan "Server: wapp\r"
    puts $chan "Connection: close\r"
  }
  if {[dict exists $wapp .reply-extra]} {
    foreach {name value} [dict get $wapp .reply-extra] {
      puts $chan "$name: $value\r"
    }
  }
  if {[dict exists $wapp .csp]} {
    set csp [dict get $wapp .csp]
    regsub {\n} [string trim $csp] { } csp
    puts $chan "Content-Security-Policy: $csp\r"
  }
  set mimetype [dict get $wapp .mimetype]
  puts $chan "Content-Type: $mimetype\r"
  if {[dict exists $wapp .new-cookies]} {
    foreach {nm val} [dict get $wapp .new-cookies] {
      if {[regexp {^[a-z][-a-z0-9_]*$} $nm]} {
        if {$val==""} {
          puts $chan "Set-Cookie: $nm=; HttpOnly; Path=/; Max-Age=1\r"
        } else {
          set val [wappInt-enc-url $val]
          puts $chan "Set-Cookie: $nm=$val; HttpOnly; Path=/\r"
        }
      }
    }
  }
  if {[string match text/* $mimetype]} {
    set reply [encoding convertto utf-8 [dict get $wapp .reply]]
    if {[regexp {\ygzip\y} [wapp-param HTTP_ACCEPT_ENCODING]]} {
      catch {wappInt-gzip-reply reply chan}
    }
  } else {
    set reply [dict get $wapp .reply]
  }
  puts $chan "Content-Length: [string length $reply]\r"
  puts $chan \r
  puts -nonewline $chan $reply
  flush $chan
  wappInt-close-channel $chan
}

# Compress the reply content
#
proc wappInt-gzip-reply {replyVar chanVar} {
  upvar $replyVar reply $chanVar chan
  set x [zlib gzip $reply]
  set reply $x
  puts $chan "Content-Encoding: gzip\r"
}

# This routine runs just prior to request-handler dispatch.  The
# default implementation is a no-op, but applications can override
# to do additional transformations or checks.
#
proc wapp-before-dispatch-hook {} {return}







|

|
|
|



|





|


|




|


|












|
|











|







745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
  set rc [dict get $wapp .reply-code]
  if {$rc=="ABORT"} {
    # If the page handler invokes "wapp-reply-code ABORT" then close the
    # TCP/IP connection without sending any reply
    wappInt-close-channel $chan
    return
  } elseif {$chan=="stdout"} {
    puts $chan "Status: $rc"
  } else {
    puts $chan "HTTP/1.1 $rc"
    puts $chan "Server: wapp"
    puts $chan "Connection: close"
  }
  if {[dict exists $wapp .reply-extra]} {
    foreach {name value} [dict get $wapp .reply-extra] {
      puts $chan "$name: $value"
    }
  }
  if {[dict exists $wapp .csp]} {
    set csp [dict get $wapp .csp]
    regsub {\n} [string trim $csp] { } csp
    puts $chan "Content-Security-Policy: $csp"
  }
  set mimetype [dict get $wapp .mimetype]
  puts $chan "Content-Type: $mimetype"
  if {[dict exists $wapp .new-cookies]} {
    foreach {nm val} [dict get $wapp .new-cookies] {
      if {[regexp {^[a-z][-a-z0-9_]*$} $nm]} {
        if {$val==""} {
          puts $chan "Set-Cookie: $nm=; HttpOnly; Path=/; Max-Age=1"
        } else {
          set val [wappInt-enc-url $val]
          puts $chan "Set-Cookie: $nm=$val; HttpOnly; Path=/"
        }
      }
    }
  }
  if {[string match text/* $mimetype]} {
    set reply [encoding convertto utf-8 [dict get $wapp .reply]]
    if {[regexp {\ygzip\y} [wapp-param HTTP_ACCEPT_ENCODING]]} {
      catch {wappInt-gzip-reply reply chan}
    }
  } else {
    set reply [dict get $wapp .reply]
  }
  puts $chan "Content-Length: [string length $reply]"
  puts $chan ""
  puts -nonewline $chan $reply
  flush $chan
  wappInt-close-channel $chan
}

# Compress the reply content
#
proc wappInt-gzip-reply {replyVar chanVar} {
  upvar $replyVar reply $chanVar chan
  set x [zlib gzip $reply]
  set reply $x
  puts $chan "Content-Encoding: gzip"
}

# This routine runs just prior to request-handler dispatch.  The
# default implementation is a no-op, but applications can override
# to do additional transformations or checks.
#
proc wapp-before-dispatch-hook {} {return}