Mercurial > hg > Members > kono > nitros9-code
annotate level1/cmds/httpd.b09 @ 3169:1ff3d7673e36
mc09 l2: bring sys/makefile in line with latest organisation for other platforms
Revise bootfiles/makefile to remove sysgo from bootfile - it can be
found on the root of the disk.
| author | Neal Crook <foofoobedoo@gmail.com> |
|---|---|
| date | Mon, 17 Apr 2017 22:59:28 +0100 |
| parents | d660d443fe5f |
| children |
| rev | line source |
|---|---|
| 2719 | 1 PROCEDURE httpd |
| 2 | |
| 3 (* HTTPD09 - process one http request, should be spawned by inetd *) | |
| 4 | |
| 5 | |
| 6 ! This program is free software: you can redistribute it and/or modify | |
| 7 ! it under the terms of the GNU General Public License as published by | |
| 8 ! the Free Software Foundation, either version 3 of the License, or | |
| 9 ! (at your option) any later version. | |
| 10 | |
| 11 ! This program is distributed in the hope that it will be useful, | |
| 12 ! but WITHOUT ANY WARRANTY; without even the implied warranty of | |
| 13 ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
| 14 ! GNU General Public License for more details. | |
| 15 | |
| 16 | |
| 17 ON ERROR GOTO 99 | |
| 18 BASE 0 | |
| 19 | |
| 20 DIM fp:BYTE | |
| 21 DIM errnum:BYTE | |
| 22 DIM req:STRING[255] | |
| 23 DIM target:STRING[255] | |
| 24 DIM lf:BYTE | |
| 25 DIM cr:BYTE | |
| 26 DIM inbyte:BYTE | |
| 27 DIM buffer(256):BYTE | |
| 28 TYPE RREGISTERS=CC,A,B:BYTE; DP:BYTE; X,Y,U:INTEGER | |
| 29 DIM rregs:RREGISTERS | |
| 30 DIM reqid:BYTE | |
| 31 DIM i,p:INTEGER | |
| 32 DIM httperr:STRING[40] | |
| 33 DIM dent(32):BYTE | |
| 34 | |
| 35 lf=10 | |
| 36 cr=13 | |
| 37 | |
| 38 (* turn off echo on the input path *) | |
| 39 (* this will be done by inetd in the future *) | |
| 40 | |
| 41 (* get ss.opt *) | |
| 42 rregs.A = 0 | |
| 43 rregs.B = 0 | |
| 44 rregs.X = ADDR(buffer) | |
| 45 reqid = $8D | |
| 46 RUN SYSCALL(reqid,rregs) | |
| 47 | |
| 48 (* set PD.EKO to 0 *) | |
| 49 buffer(4) = 0 | |
| 50 | |
| 51 (* set ss.opt *) | |
| 52 rregs.A = 0 | |
| 53 rregs.B = 0 | |
| 54 rregs.X = ADDR(buffer) | |
| 55 reqid = $8E | |
| 56 RUN SYSCALL(reqid,rregs) | |
| 57 | |
| 58 (* read headers from client *) | |
| 59 REPEAT | |
| 60 | |
| 61 req = "" | |
| 62 | |
| 63 REPEAT | |
| 64 GET #0,inbyte | |
| 65 req = req + chr$(inbyte) | |
| 66 UNTIL inbyte = 13 or EOF(#0) | |
| 67 | |
| 68 IF LEFT$(req,4) = "GET " THEN | |
| 69 target = req | |
| 70 ENDIF | |
| 71 | |
| 72 UNTIL PEEK(ADDR(req)) = 13 OR EOF(#0) | |
| 73 | |
| 74 (* just die if stdin is gone.. might help with hung runbs? *) | |
| 75 IF EOF(#0) THEN 99 | |
| 76 | |
| 77 (* fixup paths *) | |
| 78 IF left$(target,6) = "GET / " THEN | |
| 79 req = "/DD/WWWROOT/index.html" | |
| 80 ELSE | |
| 81 req = mid$(target,5,len(target) - 14) | |
| 82 ENDIF | |
| 83 | |
| 84 IF right$(req,1) = "/" THEN | |
| 85 req = left$(req,len(req)-1) | |
| 86 ENDIF | |
| 87 | |
| 88 (* "security" checks *) | |
| 89 target = "" | |
| 90 FOR i=1 TO SIZE(req) | |
| 91 inbyte=ASC(MID$(req,i,1)) | |
| 92 IF $40<inbyte AND inbyte<$60 THEN | |
| 93 inbyte = inbyte + $20 | |
| 94 ENDIF | |
| 95 target=target + CHR$(inbyte) | |
| 96 NEXT i | |
| 97 IF (SUBSTR("..",req) > 0) OR (SUBSTR("/sys/",target) > 0) THEN | |
| 98 httperr = "403 Forbidden" | |
| 99 GOTO 1000 | |
| 100 ENDIF | |
| 101 | |
| 102 (* /favicon.ico *) | |
| 103 IF (req = "/favicon.ico") THEN | |
| 104 req = "/DD/WWWROOT/favicon.ico" | |
| 105 ENDIF | |
| 106 | |
| 107 ON ERROR GOTO 100 | |
| 108 OPEN #fp,req:READ | |
| 109 ON ERROR GOTO 50 | |
| 110 httperr = "200 OK" | |
| 111 GOSUB 2000 | |
| 112 | |
| 113 IF RIGHT$(req,4) = ".htm" OR RIGHT$(req,5) = ".html" THEN | |
| 114 PRINT "Content-Type: text/html" | |
| 115 ELSE | |
| 116 IF RIGHT$(req,4) = ".jpg" THEN | |
| 117 PRINT "Content-Type: image/jpeg" | |
| 118 ELSE | |
| 119 IF RIGHT$(req,4) = ".gif" THEN | |
| 120 PRINT "Content-Type: image/gif" | |
| 121 ELSE | |
| 122 IF RIGHT$(req,4) = ".png" THEN | |
| 123 PRINT "Content-Type: image/png" | |
| 124 ELSE | |
| 125 IF RIGHT$(req,4) = ".ico" THEN | |
| 126 PRINT "Content-Type: image/x-icon" | |
| 127 PRINT "Cache-Control: public, max-age=31536000" | |
| 128 ELSE | |
| 129 PRINT "Content-Type: text/plain" | |
| 130 ENDIF | |
| 131 ENDIF | |
| 132 ENDIF | |
| 133 ENDIF | |
| 134 ENDIF | |
| 135 | |
| 136 PUT #1,lf | |
| 137 | |
| 138 (* send file contents *) | |
| 139 REPEAT | |
| 140 | |
| 141 rregs.A = fp | |
| 142 rregs.Y = 256 | |
| 143 rregs.X = ADDR(buffer) | |
| 144 reqid = $89 | |
| 145 RUN SYSCALL(reqid,rregs) | |
| 146 | |
| 147 rregs.A = 1 | |
| 148 rregs.X = ADDR(buffer) | |
| 149 reqid = $8A | |
| 150 RUN SYSCALL(reqid,rregs) | |
| 151 | |
| 152 UNTIL EOF(#fp) | |
| 153 | |
| 154 50 ON ERROR GOTO 99 | |
| 155 CLOSE #fp | |
| 156 | |
| 157 target = DATE$ + " 200 OK " + req | |
| 158 GOSUB 3000 | |
| 159 | |
| 160 99 END | |
| 161 | |
| 162 | |
| 163 100 ON ERROR GOTO 99 | |
| 164 errnum := ERR | |
| 165 | |
| 166 IF errnum = 214 THEN | |
| 167 (* directory check *) | |
| 168 ON ERROR GOTO 200 | |
| 169 OPEN #fp,req:READ+DIR | |
| 170 ON ERROR GOTO 99 | |
| 171 | |
| 172 httperr = "200 OK" | |
| 173 GOSUB 2000 | |
| 174 PRINT "Content-Type: text/html" | |
| 175 PUT #1,lf | |
| 176 | |
| 177 PRINT "<HTML><HEAD><TITLE>" | |
| 178 PRINT "Directory of ";req | |
| 179 PRINT "</TITLE></HEAD><BODY>" | |
| 180 | |
| 181 PRINT "<H3>Directory of ";req;"</H3>" | |
| 182 PRINT "<HR>" | |
| 183 | |
| 184 REPEAT | |
| 185 | |
| 186 get #fp,dent | |
| 187 | |
| 188 IF dent(0) > 0 THEN | |
| 189 | |
| 190 target = "" | |
| 191 inbyte = dent(0) | |
| 192 i = 0 | |
| 193 WHILE inbyte < 128 AND i<29 DO | |
| 194 | |
| 195 target = target + chr$(inbyte) | |
| 196 i = i + 1 | |
| 197 inbyte = dent(i) | |
| 198 | |
| 199 ENDWHILE | |
| 200 | |
| 201 target = target + chr$(inbyte - 128) | |
| 202 | |
| 203 IF target <> "." THEN | |
| 204 PRINT "<A HREF=";req;"/";target;">";target;"</A>" | |
| 205 PRINT "<br>" | |
| 206 ENDIF | |
| 207 | |
| 208 ENDIF | |
| 209 | |
| 210 UNTIL EOF(#fp) | |
| 211 CLOSE #fp | |
| 212 | |
| 213 GOSUB 2100 | |
| 214 PRINT "</BODY></HTML>" | |
| 215 | |
| 216 target = DATE$ + " 200 OK (dir) " + req | |
| 217 GOSUB 3000 | |
| 218 END | |
| 219 ELSE | |
| 220 IF errnum = 216 THEN | |
| 221 httperr = "404 Not Found" | |
| 222 ELSE | |
| 223 IF errnum = 215 THEN | |
| 224 httperr = "400 Bad Request" | |
| 225 ELSE | |
| 226 httperr = "500 Internal Server Error" | |
| 227 ENDIF | |
| 228 ENDIF | |
| 229 | |
| 230 GOTO 1000 | |
| 231 ENDIF | |
| 232 | |
| 233 | |
| 234 | |
| 235 200 ON ERROR GOTO 99 | |
| 236 httperr = "403 Forbidden" | |
| 237 (* error result *) | |
| 238 1000 GOSUB 2000 | |
| 239 PRINT "Content-Type: text/html" | |
| 240 PUT #1,lf | |
| 241 | |
| 242 PRINT "<HTML>" | |
| 243 PRINT "<HEAD><TITLE>";httperr;"</TITLE></HEAD>" | |
| 244 PRINT "<BODY><H2>";httperr;"</H2>" | |
| 245 GOSUB 2100 | |
| 246 PRINT "</BODY></HTML>" | |
| 247 target = DATE$ + " " + httperr + " " + req | |
| 248 GOSUB 3000 | |
| 249 END | |
| 250 | |
| 251 | |
| 252 (* server headers *) | |
| 253 2000 PRINT "HTTP/1.1 ";httperr | |
| 254 PRINT "Server: CoCoHTTPD" | |
| 255 PRINT "Connection: close" | |
| 256 RETURN | |
| 257 | |
| 258 (* footer *) | |
|
2820
d660d443fe5f
Changed set to equ in __os9 section so stack/edition/etc are honored by lwlink
Boisy Pitre <boisy.pitre@nuance.com>
parents:
2719
diff
changeset
|
259 2100 PRINT "<br><HR><font face=Tahoma;Arial;Sans size=2><i>httpd09 version 1.1 - ";DATE$;"</i></font>" |
| 2719 | 260 RETURN |
| 261 | |
| 262 | |
| 263 (* logging - string to log in target *) | |
| 264 3000 ON ERROR GOTO 3010 | |
| 265 CREATE #fp,"/DD/LOG/httpd.log":WRITE | |
| 266 ON ERROR GOTO 3030 | |
| 267 GOTO 3020 | |
| 268 3010 ON ERROR GOTO 3040 | |
| 269 OPEN #fp,"/DD/LOG/httpd.log":WRITE | |
| 270 ON ERROR GOTO 3030 | |
| 271 (* getstat ss.siz *) | |
| 272 rregs.A = fp | |
| 273 rregs.B = $02 | |
| 274 reqid = $8D | |
| 275 RUN SYSCALL(reqid,rregs) | |
| 276 (* seek to eof *) | |
| 277 rregs.A = fp | |
| 278 reqid = $88 | |
| 279 RUN SYSCALL(reqid,rregs) | |
| 280 3020 WRITE #fp,target | |
| 281 3030 ON ERROR GOTO 3040 | |
| 282 CLOSE #fp | |
| 283 3040 ON ERROR GOTO 99 | |
| 284 RETURN |