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

  1. # an experiment in over-abstraction
  2. namespace eval parse {
  3.  
  4. proc Def {name vars body} {
  5. dict set map @VARS@ [list $vars]
  6. dict set map @BODY@ $body
  7.  
  8. tailcall proc $name {Input Vars {Script ""}} [string map $map {
  9. set R [@BODY@]
  10. foreach V @VARS@ {
  11. if {$V in $Vars} {
  12. uplevel 1 [list set $V [set $V]]
  13. }
  14. }
  15. if {$Script eq ""} {
  16. return $R
  17. } else {
  18. tailcall try $Script
  19. }
  20. }]
  21. }
  22.  
  23. Def request {verb dest httpver} {
  24. regexp {^([A-Z]+) (.*) (HTTP/.*)$} $Input -> verb dest httpver
  25. }
  26. Def absoluteURI {scheme host port path} {
  27. expr {[regexp {^(\w+)://\[([^\]/ ]+)\](?::(\d+))?(.*)$} $Input -> scheme host port path]
  28. || [regexp {^(\w+)://([^:/ ]+)(?::(\d+))?(.*)$} $Input -> scheme host port path]}
  29. }
  30. Def hostPort {host port} {
  31. expr {[regexp {^([^:/ ]+)(?::(\d+))?$} $dest -> host port]
  32. && [regexp {^\[([^\]/ ]+)\](?::(\d+))?$} $dest -> host port]}
  33. }
  34. Def hostHeader {host port} {
  35. regexp -line {^Host: (.*)?(?::(.*))$} $Input -> host port
  36. }
  37. Def basicAuth {user pass} {
  38. expr {[regexp -line {^Proxy-Authorization: Basic (.*)$} $headers -> creds]
  39. && [regexp {^(.*?):(.*)$} [binary decode base64 $creds] -> user pass]}
  40. }
  41. }
  42.  
  43. proc putl args {puts $args}
  44.  
  45. parse::request {GET https://google.com/dede HTTP/1.2} {verb dest httpver} {
  46. putl $httpver $verb
  47. if {[parse::absoluteURI $dest {scheme host port path}]} {
  48. putl abs: $scheme $host $port $path
  49. } elseif {[parse::hostPort $dest {host port}]} {
  50. putl hostport: $host $port
  51. }
  52. }
  53. puts [info body parse::hostPort]
  54.  
  55. # .. this came from wanting to make this stuff reusable without duplication:
  56. # if {![regexp {^([A-Z]+) (.*) (HTTP/.*)$} $request -> verb dest httpver]} {
  57. # return
  58. # }
  59. # if {[regexp {^(\w+)://\[([^\]/ ]+)\](?::(\d+))?(.*)$} $dest -> scheme host port path]} {
  60. # # IPv6 URL
  61. # } elseif {[regexp {^(\w+)://([^:/ ]+)(?::(\d+))?(.*)$} $dest -> scheme host port path]} {
  62. # # normal URL
  63. # } else {
  64. # return ;# nothing I can handle here!
  65. # }
  66.  
  67.