| | 1 | ( ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ) |
| | 2 | ( HTTP/0.9 Server ) |
| | 3 | ( Charles Childers, 2010 ) |
| | 4 | ( ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ) |
| | 5 | ( See http://www.w3.org/Protocols/HTTP/AsImplemented.html ) |
| | 6 | ( ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ) |
| | 7 | ( This is a really simple web server intended to show how ) |
| | 8 | ( sockets and the net/server library can be used. ) |
| | 9 | ( ) |
| | 10 | ( Some features: ) |
| | 11 | ( - 7 words; under 2k cells when compiled ) |
| | 12 | ( - serve actual html files ) |
| | 13 | ( - log requests to terminal window ) |
| | 14 | ( - handler for 404 errors ) |
| | 15 | ( - can be killed by visiting a special page ) |
| | 16 | ( ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ) |
| | 17 | |
| | 18 | include library/net/server.retro |
| | 19 | include library/files.retro |
| | 20 | |
| | 21 | vocab httpd/0.9 |
| | 22 | (( |
| | 23 | : 404 ( -a ) s" <html><body><h1>Error 404!</h1></body></html>" ; |
| | 24 | : GET? ( - ) |
| | 25 | repeat |
| | 26 | <get> nib s" GET" compare if <get> ." Requested: " nib type cr ;then |
| | 27 | again ; |
| | 28 | : INDEX? ( - ) nib s" /" compare if s" index.html" ;then nib 1+ ; |
| | 29 | : ERROR? ( - ) here @ if here ;then 404 ; |
| | 30 | : EXIT? ( - ) nib s" /shutdown" compare if s" <html><body><h1>Retro-HTTPd shut
down</h1></body></html>" <send> }serve cleanup bye then ; |
| | 31 | : SEND ( - ) here swap slurp ERROR? <send> ; |
| | 32 | : start ( - ) newServer 9812 claim repeat serve{ GET? EXIT? INDEX? SEND }serve again ; |
| | 33 | )) |