Posted to tcl by aspect at Sat Jul 09 15:33:07 GMT 2016view pretty

# an experiment in over-abstraction
namespace eval parse {

    proc Def {name vars body} {
        dict set map @VARS@ [list $vars]
        dict set map @BODY@ $body

        tailcall proc $name {Input Vars {Script ""}} [string map $map {
            set R [@BODY@]
            foreach V @VARS@ {
                if {$V in $Vars} {
                    uplevel 1 [list set $V [set $V]]
                }
            }
            if {$Script eq ""} {
                return $R
            } else {
                tailcall try $Script
            }
        }]
    }

    Def request {verb dest httpver} {
        regexp {^([A-Z]+) (.*) (HTTP/.*)$} $Input -> verb dest httpver
    }
    Def absoluteURI {scheme host port path} {
        expr {[regexp {^(\w+)://\[([^\]/ ]+)\](?::(\d+))?(.*)$} $Input -> scheme host port path]
           || [regexp {^(\w+)://([^:/ ]+)(?::(\d+))?(.*)$} $Input -> scheme host port path]}
    }
    Def hostPort {host port} {
        expr {[regexp {^([^:/ ]+)(?::(\d+))?$} $dest -> host port]
           && [regexp {^\[([^\]/ ]+)\](?::(\d+))?$} $dest -> host port]}
    }
    Def hostHeader {host port} {
        regexp -line {^Host: (.*)?(?::(.*))$} $Input -> host port
    }
    Def basicAuth {user pass} {
        expr {[regexp -line {^Proxy-Authorization: Basic (.*)$} $headers -> creds]
           && [regexp {^(.*?):(.*)$} [binary decode base64 $creds] -> user pass]}
    }
}

proc putl args {puts $args}

parse::request {GET https://google.com/dede HTTP/1.2} {verb dest httpver} {
    putl $httpver $verb
    if {[parse::absoluteURI $dest {scheme host port path}]} {
        putl abs: $scheme $host $port $path
    } elseif {[parse::hostPort $dest {host port}]} {
        putl hostport: $host $port
    }
}
puts [info body parse::hostPort]

# .. this came from wanting to make this stuff reusable without duplication:
#        if {![regexp {^([A-Z]+) (.*) (HTTP/.*)$} $request -> verb dest httpver]} {
#            return
#        }
#        if {[regexp {^(\w+)://\[([^\]/ ]+)\](?::(\d+))?(.*)$} $dest -> scheme host port path]} {
#            # IPv6 URL
#        } elseif {[regexp {^(\w+)://([^:/ ]+)(?::(\d+))?(.*)$} $dest -> scheme host port path]} {
#            # normal URL
#        } else {
#            return  ;# nothing I can handle here!
#        }