http/httpreq.st

   1 "
   2  coded by Ketmar // Vampire Avalon (psyc://ketmar.no-ip.org/~Ketmar)
   3  Understanding is not required. Only obedience.
   4
   5  This program is free software. It comes without any warranty, to
   6  the extent permitted by applicable law. You can redistribute it
   7  and/or modify it under the terms of the Do What The Fuck You Want
   8  To Public License, Version 2, as published by Sam Hocevar. See
   9  http://sam.zoy.org/wtfpl/COPYING for more details.
  10 "
  11
  12 "TODO: cookies"
  13 Package [
  14   HttpServer
  15 ]
  16
  17
  18 String extend [
  19   htmlEscape [
  20     "encode '<>&'"
  21     | res |
  22     (self includes: '<>&') ifFalse: [ ^self ].
  23     res := StringBuffer new.
  24     self do: [:c |
  25       c == $< ifTrue: [ res << '&lt;' ]
  26       ifFalse: [
  27         c == $> ifTrue: [ res << '&gt;' ]
  28         ifFalse: [
  29           c == $& ifTrue: [ res << '&amp;' ]
  30           ifFalse: [ res << c ]]]].
  31     ^res asString
  32   ]
  33 ]
  34
  35
  36 class: HTTPRequest [
  37 | sock
  38   reqStr
  39   abortBlock
  40   "parsed request"
  41   reqMethod  "string: GET, POST, etc"
  42   reqHost    "string: host name"
  43   reqPath    "string: path"
  44   reqFile    "string: file name"
  45   reqHash    "string: text after '#'"
  46   reqVars    "dictionary: (nameSymbol stringValue)"
  47   reqFields  "header fields"
  48 |
  49
  50   ^new: s abortBlock: aBlock [
  51     | obj |
  52     obj := self new.
  53     obj abortBlock: aBlock.
  54     obj parseRequest: s.
  55     ^obj
  56   ]
  57
  58   ^new: s [
  59     ^self new: s abortBlock: [:err | self error: err ]
  60   ]
  61
  62   debugDump [
  63     'method: ' print. reqMethod print. '|' printNl.
  64     'host: ' print. reqHost print. '|' printNl.
  65     'path: ' print. reqPath print. '|' printNl.
  66     'file: ' print. reqFile print. '|' printNl.
  67     'hash: ' print. reqHash print. '|' printNl.
  68     'vars: ' print. reqVars print. '|' printNl.
  69     'fields: ' print. reqFields print. '|' printNl.
  70   ]
  71
  72   abortBlock: aBlock [
  73     abortBlock := aBlock
  74   ]
  75
  76   path [
  77     ^reqPath
  78   ]
  79
  80   file [
  81     ^reqFile
  82   ]
  83
  84   hash [
  85     ^reqHash
  86   ]
  87
  88   host [
  89     ^reqHost
  90   ]
  91
  92   method [
  93     ^reqMethod
  94   ]
  95
  96   var: aName [
  97     ^reqVars at: aName asSymbol ifAbsent: [ nil ].
  98   ]
  99
 100   var: aName ifAbsent: aBlock [
 101     ^reqVars at: aName asSymbol ifAbsent: [ aBlock value ].
 102   ]
 103
 104   var: aName put: aValue [
 105     reqVars at: aName asSymbol put: aValue.
 106   ]
 107
 108   reqStr: str [
 109     reqStr := str
 110   ]
 111
 112   field: aName [
 113     ^reqFields at: aName ifAbsent: [ nil ]
 114   ]
 115
 116   parseRequest [
 117     | lines req |
 118     lines := (reqStr removeTrailingBlanks break: '\n') asArray.
 119     lines size < 1 ifTrue: [ abortBlock value: 'empty header' ].
 120     lines transform: [:str | str removeTrailingBlanks ].
 121     (req := (lines at: 1) break: ' ') size < 3 ifTrue: [ abortBlock value: 'invalid request line' ].
 122     reqMethod := req at: 1.
 123     self parsePath: (req at: 2).
 124     self parseFields: lines.
 125     reqHost := reqFields at: 'host' ifAbsent: [ reqHost ].
 126   ]
 127
 128   parseFields: lines [
 129     | s p n v |
 130     reqFields := Dictionary new.
 131     "TODO: lines starting with space is 'continuation'"
 132     2 to: lines size do: [:idx |
 133       (p := (s := lines at: idx) position: $:) ifNotNil: [
 134         n := (s from: 1 to: p - 1) transform: [:c | c lowerCase ].
 135         p := p + 1.
 136         [(p < s size) and: [ (s at: p) isBlank ]] whileTrue: [ p := p + 1 ].
 137         v := s from: p.
 138         reqFields at: n put: v.
 139         "n print. '|' print. v print. '|' printNl."
 140       ].
 141     ].
 142   ]
 143
 144   parsePath: aPath [
 145     | p |
 146     reqHash := ''. reqHost := ''.
 147     reqVars := Dictionary new.
 148     (aPath from: 1 to: 7) = 'http://' ifTrue: [
 149       "we have a host here"
 150       (p := (aPath := aPath from: 8) indexOf: '/') ifNil: [
 151         reqHost := aPath
 152         aPath := '/'.
 153        ] ifNotNil: [
 154         reqHost := aPath from: 1 to: p - 1.
 155         aPath := aPath from: p.
 156        ].
 157     ].
 158     (p := aPath indexOf: '?') ifNil: [
 159         (p := aPath indexOf: '#') ifNil: [
 160           reqPath := aPath.
 161          ] ifNotNil: [
 162            reqPath := aPath from: 1 to: p - 1.
 163            reqHash := aPath from: p + 1.
 164          ].
 165      ] ifNotNil: [
 166        reqPath := aPath from: 1 to: p - 1.
 167        aPath := aPath from: p + 1.
 168        (p := aPath indexOf: '#') ifNotNil: [
 169          reqHash := aPath from: p + 1.
 170          aPath := aPath from: 1 to: p - 1.
 171         ].
 172         self parseVars: aPath.
 173      ].
 174      "
 175      [ 'rp: ' print. reqPath printNl.
 176        self normPath.
 177        'rp: ' print. reqPath print. '|' print. reqFile print. '|' printNl.
 178      ] runLocked.
 179      "
 180      self normPath.
 181   ]
 182
 183   parseVars: aVars [
 184     (aVars break: '&') do: [:vv :p :n :v |
 185       (p := vv indexOf: '=') ifNil: [
 186         n := vv.
 187         v := true.
 188        ] ifNotNil: [
 189         n := (vv from: 1 to: p - 1) fromUrl.
 190         v := (vv from: p + 1) fromUrl.
 191        ].
 192       self var: n put: v.
 193     ].
 194   ]
 195
 196   normPath [
 197     | p res |
 198     reqPath isEmpty ifTrue: [ reqPath := '/'. reqFile := ''. ^self ].
 199     reqPath lastChar == $/
 200       ifTrue: [
 201         reqFile := ''.
 202       ] ifFalse: [
 203         (p := reqPath lastPosition: $/) ifNil: [ reqFile := reqPath. reqPath := '/'. ^self ].
 204         reqFile := reqPath from: p+1.
 205         reqPath := reqPath from: 1 to: p-1.
 206       ].
 207     p := reqPath break: '/'.
 208     res := List new.
 209     p do: [:dir |
 210       dir = '.' ifFalse: [
 211         dir = '..' ifTrue: [
 212           res isEmpty ifFalse: [ res removeFirst ]
 213         ] ifFalse: [
 214           res add: dir
 215         ].
 216       ]
 217     ].
 218     p := '/'.
 219     res do: [:dir | p := '/' + dir + p ].
 220     reqPath := p.
 221   ]
 222
 223   parseRequest: s [
 224     reqStr := s.
 225     self parseRequest.
 226     reqStr := nil.
 227   ]
 228 ]