Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP

Loading…

Gzip, UTF-8, CORS e.t.c. #1

Merged
merged 9 commits into from

2 participants

@dzach

Took me a while to get used to github's dashboard and get it right (hopefully)
.
So here are some changes to wibble, mostly made back in April. The utf-8 change has been tested with the Greek and Latin character sets.

Regards
Dimitrios

dz and others added some commits
@jcowgar jcowgar merged commit e4926d5 into jcowgar:master
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Commits on Oct 7, 2011
  1. Added pkgIndex.tcl to the package

    dz authored
  2. UTF-8 characters are not decoded properly. Converting from utf-8 does…

    dz authored
    … it, while it does not change iso8859-1 chars
  3. Added support for gzip compression.

    dz authored
    Content is now compressed if the Content-Encoding HTTP header is gzip
  4. Added HTTP headers to the list of normalized headers to conform with h…

    Dimitrios Zachariadis authored
    …ttp://www.w3.org/TR/cors Cross-Origin Resource Sharing spec.
    
    Signed-off-by: Dimitrios Zachariadis <dzach@telemetry.gr>
  5. Merge branch 'work'

    Dimitrios Zachariadis authored
  6. Tidy up header list

    Dimitrios Zachariadis authored
This page is out of date. Refresh to see the latest.
Showing with 35 additions and 5 deletions.
  1. +9 −3 example.tcl
  2. +3 −0  pkgIndex.tcl
  3. +23 −2 wibble.tcl
View
12 example.tcl 100644 → 100755
@@ -1,4 +1,8 @@
-source wibble.tcl
+#!/usr/bin/tclsh8.6
+# change the above line to point to the tclsh8.6 executable
+
+lappend auto_path .
+package require wibble
# =============================== example code ================================
@@ -17,9 +21,11 @@ if {$argv0 eq [info script]} {
::wibble::handle / dirlist root $root
::wibble::handle / notfound
- # Start a server and enter the event loop.
+ # Start a server and enter the event loop if not already there.
catch {
::wibble::listen 8080
- vwait forever
+ if {!$tcl_interactive} {
+ vwait forever
+ }
}
}
View
3  pkgIndex.tcl
@@ -0,0 +1,3 @@
+# package index for wibble
+if {![package vsatisfies [package provide Tcl] 8.6]} {error "Tcl 8.6 is required"}
+package ifneeded wibble 0.1 [list source [file join $dir wibble.tcl]]
View
25 wibble.tcl 100644 → 100755
@@ -643,7 +643,7 @@ proc ::wibble::getrequest {port chan peerhost peerport} {
# Receive and parse the first line. Process "." and ".." path components.
regexp {^\s*(\S*)\s+(\S*)\s+(.*?)\s*$} [getline] _ method uri protocol
regexp {^([^?]*)(\?.*)?$} $uri _ path query
- set path [regsub -all {(?:/|^)\.(?=/|$)} [dehex $path] /]
+ set path [regsub -all {(?:/|^)\.(?=/|$)} [encoding convertfrom utf-8 [dehex $path]] /]
while {[regexp -indices {(?:/[^/]*/+|^[^/]*/+|^)\.\.(?=/|$)} $path range]} {
set path [string replace $path {*}$range ""]
}
@@ -827,6 +827,23 @@ proc ::wibble::process {port socket peerhost peerport} {
if {[dict get $request method] ne "HEAD"} {
set file [open [dict get $response contentfile]]
}
+ } elseif {[dict exists $response header content-encoding] &&
+ [dict get $response header content-encoding] eq "gzip"
+ } {
+ set gzip [binary format "H*iH*" "1f8b0800" [clock seconds] "0003"]
+ set content [dict get $response content]
+ append gzip [zlib deflate $content]
+ append gzip [binary format i [zlib crc32 $content]]
+ append gzip [binary format i [string length $content]]
+ set response [dict merge $response {
+ header {
+ Vary Accept-Encoding
+ Content-Encoding gzip
+ Accept-Ranges bytes
+ }
+ }]
+ dict set response content $gzip
+ set size [string length [dict get $response content]]
} elseif {[dict exists $response contentchan]} {
if {[dict exists $response contentsize]} {
set size [dict get $response contentsize]
@@ -869,7 +886,11 @@ proc ::wibble::process {port socket peerhost peerport} {
Content-Length Content-Location Content-MD5 Content-Range
Content-Type Date ETag Expires Last-Modified Location Pragma
Proxy-Authenticate Retry-After Server Set-Cookie Trailer
- Transfer-Encoding Upgrade Vary Via Warning WWW-Authenticate
+ Transfer-Encoding Upgrade Vary Via Warning WWW-Authenticate
+ Access-Control-Allow-Origin Origin Access-Control-Allow-Credentials
+ Access-Control-Expose-Headers Access-Control-Max-Age
+ Access-Control-Allow-Methods Access-Control-Allow-Headers
+ Access-Control-Request-Method Access-Control-Request-Headers
} $key]
if {$normalizedkey ne ""} {
set key $normalizedkey
Something went wrong with that request. Please try again.