home *** CD-ROM | disk | FTP | other *** search
/ The Datafile PD-CD 3 / PDCD_3.iso / internet / freenet / httpsrvr_0 / SERVER
Text File  |  1995-07-03  |  13KB  |  442 lines
  1. REM >httpServer
  2. END=1024*128: REM 96K WimpSlot
  3.  
  4. REM Change this to be your authorisation keyword
  5. REM If you want a secure server, leave it as empty string
  6. root_pw$=""
  7.  
  8. REM Change this line to the root of your web pages
  9. lib$="ADFS::HardDisc5.$.Internet.WWWPages"
  10. end%=FALSE:socket%=-1:connect%=-1:cc%=0:maxknx%=4
  11.  
  12. lastmax%=TIME
  13. bufsiz%=1024
  14. port%=80
  15. nl$=CHR$10
  16. task$="HTTP Server ("+STR$port%+")"
  17. server$="Server: RISCOS/3.5 httpserver/0.8beta"
  18. sig$="RISC OS httpd 0.8 (Acorn RiscPC600 25MB) (<a href=""http://louis.ecs.soton.ac.uk/~snb94r/httpd.html"">S.N.Brodie</a>)"
  19. DIM taskid%8,q%&100,select_read%32,select_write%32,select_excep%32,timeout%8
  20. DIM iobuf%64,remotehost%16,hostsize%4,valid_sel%32,connect_sel%32
  21. DIM data_sel%32
  22. DIM knx%(maxknx%),port%(maxknx%),io%(maxknx%),ptr%(maxknx%),first%(maxknx%),url$(maxknx%)
  23. DIM file%(maxknx%),ext%(maxknx%),len%(maxknx%),file$(maxknx%),mime$(maxknx%),redir%(maxknx%)
  24. DIM rocont$(maxknx%)
  25. url$() = STRING$(254," "):url$() = "": REM Reserve memory NOW
  26. file$() = STRING$(254," "):file$() = "": REM Ditto
  27. mime$() = "application/octet-stream": mime$() = "": REM Ditto
  28. rocont$() = "X-RiscOS-Filetype: xxx "
  29. redir%() = 0
  30. ptr%()=0
  31. knx%()=-1
  32. file%()=-1
  33. ON ERROR:PROC_errstop:END
  34. PROC_init
  35. $taskid%="TASK"
  36. SYS "Wimp_Initialise", 310, !taskid%, task$, -1 TO ,task_id%
  37. del%=0
  38. WHILE NOT end%
  39.   SYS "Wimp_PollIdle",,q%,FN_timenow+del% TO reason%
  40.   CASE reason% OF
  41.     WHEN 1: SYS "Wimp_RedrawWindow",,q% TO more%
  42.             WHILE more%:SYS "Wimp_GetRectange",,q% TO more%:ENDWHILE
  43.     WHEN 2: SYS "Wimp_OpenWindow",,q%
  44.     WHEN 3: SYS "Wimp_CloseWindow",,q%
  45.     WHEN 17,18: PROC_message
  46.     OTHERWISE: PROC_select
  47.   ENDCASE
  48. ENDWHILE
  49. PROC_exit
  50. END
  51.  
  52. DEF FN_lower(A$):LOCALB$,B%,C%:B$="":FORB%=1 TO LENA$:C%=ASCMID$(A$,B%)
  53. IFC%>=65 AND C%<=90 C%+=32
  54. B$+=CHR$C%:NEXT:=B$
  55.  
  56. DEF FN_timenow:LOCALA%:SYS "OS_ReadMonotonicTime" TO A%:=A%
  57.  
  58. DEF FN_task_same
  59. y$="":y%=q%+28:WHILE (?y%) >=32:y$+=CHR$(?y%):y%+=1:ENDWHILE
  60. =(y$=task$)
  61.  
  62. DEF FN_zero(ptr%):LOCAL A$:A$=""
  63. WHILELENA$<255 AND ?ptr%:A$+=CHR$(?ptr%):ptr%+=1:ENDWHILE
  64. =A$
  65.  
  66. DEF PROC_message
  67. IF q%!16 = 0 THEN end%=TRUE
  68. IF q%!16 = &400C2 AND FN_task_same AND q%!4 <> task_id% THEN end%=TRUE
  69. ENDPROC
  70.  
  71. DEF PROC_fd_zero(base%)
  72. LOCAL T%:FORT%=0 TO 28 STEP 4:base%!T%=0:NEXT
  73. ENDPROC
  74.  
  75. DEF PROC_fd_copy(base%,dest%)
  76. LOCAL T%:FORT%=0 TO 28 STEP 4:dest%!T%=base%!T%:NEXT
  77. ENDPROC
  78.  
  79. DEF PROC_fd_set(base%, fd%)
  80. IF fd%<0 OR fd%>255 THEN ENDPROC
  81. WHILE fd%>=8 :base%+=1:fd%-=8:ENDWHILE
  82. ?base%=(?base% OR (1<<fd%))
  83. ENDPROC
  84.  
  85. DEF PROC_fd_clr(base%, fd%)
  86. IF fd%<0 OR fd%>255 THEN ENDPROC
  87. WHILE fd%>=8 :base%+=1:fd%-=8:ENDWHILE
  88. ?base%=(?base% AND NOT (1<<fd%))
  89. ENDPROC
  90.  
  91. DEF FN_fd_isset(base%, fd%)
  92. IF fd%<0 OR fd%>255 THEN =FALSE
  93. WHILE fd%>=8:base%+=1:fd%-=8:ENDWHILE
  94. IF ((?base%) AND (1<<fd%)) = (1<<fd%) THEN = TRUE:
  95. =FALSE
  96.  
  97. DEF PROC_accept
  98. LOCAL X%,a$
  99. IF cc%=maxknx% THEN
  100.   IF TIME>lastmax% PROC_debug(3,"max connections")
  101.   lastmax%=TIME+500
  102.   ENDPROC
  103. ENDIF
  104. !hostsize%=16
  105. SYS "Socket_Accept", socket%, remotehost%, hostsize% TO connect%
  106. IF connect%=-1 THEN PROC_debug(0,"Failed "):ENDPROC
  107. PROC_fd_set(data_sel%, connect%)
  108. cc%+=1
  109. a$=STR$(remotehost%?4)+"."+STR$(remotehost%?5)+"."
  110. a$+=STR$(remotehost%?6)+"."+STR$(remotehost%?7)
  111. use_rev_dns%=TRUE
  112. IF use_rev_dns% THEN
  113.   SYS "XInternet_GetHostByAddr",,remotehost%+4,4,2 TO ,shp%
  114.   IF shp%>0 THEN a$=FN_zero(!shp%)
  115. ENDIF
  116. PROC_debug(0,a$+" wants http")
  117. FOR X%=1 TO maxknx%:IF knx%(X%)=-1 THEN
  118.   knx%(X%)=connect%:port%(X%)=port%:ptr%(X%)=0:first%(X%)=0:redir%(X%)=0:X%=maxknx%
  119. ENDIF
  120. NEXT
  121. connect%=-1
  122. ENDPROC
  123.  
  124. DEF PROC_conn_kill(x%)
  125. break%=TRUE
  126. IF knx%(x%) > -1 THEN
  127.   PROC_debug(3,"Closing socket "+STR$knx%(x%))
  128.   SYS "XSocket_Shutdown", knx%(x%), 2
  129.   SYS "XSocket_Close", knx%(x%)
  130.   PROC_fd_clr(data_sel%, knx%(x%))
  131.   knx%(x%)=-1
  132.   cc%-=1
  133. ENDIF
  134. IF file%(x%)>0 CLOSE #file%(x%):file%(x%)=-1
  135. url$(x%)=""
  136. ENDPROC
  137.  
  138. DEF PROC_sock_write(sock%, str$)
  139. IF LENstr$>60 THEN
  140.   PROC_sock_write(sock%, LEFT$(str$,60))
  141.   PROC_sock_write(sock%, MID$(str$,61))
  142. ELSE
  143.   $iobuf% = str$
  144.   SYS "XSocket_Write", sock%, iobuf%, LENstr$
  145. ENDIF
  146. ENDPROC
  147.  
  148. DEF PROC_resp_screen(x%,code%,id$,reason$)
  149. LOCAL s%:s%=knx%(x%)
  150. LOCAL ERROR
  151. ON ERROR LOCAL ON ERROR LOCAL OFF:ENDPROC
  152. PROC_sock_write(s%, "HTTP/1.0 "+STR$code%+" "+id$+nl$+"MIME-version: 1.0"+nl$)
  153. PROC_sock_write(s%, server$+nl$)
  154. PROC_sock_write(s%, "Content-type: text/html"+nl$+nl$)
  155. PROC_sock_write(s%, "<head><title>"+STR$code%+" "+id$+"</title></head>"+nl$)
  156. PROC_sock_write(s%, "<body><h1>"+STR$code%+" "+id$+"</h1>"+nl$+reason$)
  157. IF code%=302 ENDPROC
  158. PROC_sock_write(s%, "<p>"+nl$+"<hr>"+nl$+sig$+"</body>"+nl$)
  159. ENDPROC
  160.  
  161. DEF PROC_redirect(x%)
  162. PROC_debug(0,"302 Relocate for "+url$(x%))
  163. PROC_resp_screen(x%, 302, "Not here", "The requested document is no longer at this URL")
  164. PROC_sock_write(s%, "<p>It has moved to <a href=""")
  165. PROC_sock_write(s%, file$(x%))
  166. PROC_sock_write(s%, """>another location</a><p><hr>"+nl$)
  167. PROC_sock_write(s%, sig$+nl$)
  168. PROC_conn_kill(x%)
  169. ENDPROC
  170.  
  171. DEF PROC_not_found(x%)
  172. PROC_debug(0,"404 Not found for "+url$(x%))
  173. PROC_resp_screen(x%,404,"Not found","The request URL was not found on this server")
  174. PROC_conn_kill(x%)
  175. ENDPROC
  176.  
  177. DEF PROC_bad_request(x%)
  178. PROC_debug(0,"400 Bad access method")
  179. PROC_resp_screen(x%, 400, "Bad request", "Your client sent a query that the server could not understand")
  180. PROC_conn_kill(x%)
  181. ENDPROC
  182.  
  183.  
  184. DEF PROC_retrieve_url(x%, full%)
  185. PROC_debug(0,"200 OK for "+url$(x%))
  186. LOCAL ERROR
  187. ON ERROR LOCAL ON ERROR LOCAL OFF:ENDPROC
  188. file%(x%)=OPENIN file$(x%)
  189. IF file%(x%)=0 THEN PROC_not_found(x%):PROC_conn_kill(x%):ENDPROC
  190. SYS "OS_Args",2,file%(x%) TO ,,ext%(x%)
  191. ptr%(x%)=0
  192. len%(x%)=0
  193. IF mime$(x%)="" THEN
  194.   PROC_debug(0,"Executing CGI script "+url$(x%))
  195.   CLOSE #file%(x%)
  196.   file%(x%)=-1
  197.   tmp$="http/1.0":IF NOT full% tmp$="http/0.9"
  198.   SYS "Wimp_StartTask", file$(x%)+" "+tmp$+" -socket "+STR$knx%(x%)
  199.   break%=TRUE
  200.   cc%-=1
  201.   knx%(x%)=-1
  202.   url$(x%)=""
  203. ELSE
  204.   IF NOT full% THEN ENDPROC
  205.   PROC_sock_write(knx%(x%), "HTTP/1.0 200 OK" + nl$)
  206.   PROC_sock_write(knx%(x%), server$+nl$)
  207.   PROC_sock_write(knx%(x%), "MIME-version: 1.0"+nl$)
  208.   PROC_sock_write(knx%(x%), "Content-Type: " +mime$(x%)+ nl$)
  209.   PROC_sock_write(knx%(x%), "Content-Length: "+STR$ext%(x%)+nl$)
  210.   PROC_sock_write(knx%(x%), rocont$(x%)+nl$)
  211.   PROC_sock_write(knx%(x%), nl$)
  212. ENDIF
  213. ENDPROC
  214.  
  215. DEF PROC_do_o(x%)
  216. IF len%(x%)=0 THEN
  217.   SYS "OS_GBPB", 4, file%(x%), io%(x%), bufsiz% TO ,,,unread%
  218.   len%(x%) = bufsiz%-unread%: IF unread%=bufsiz% THEN PROC_conn_kill(x%):ENDPROC
  219. ENDIF
  220. SYS "XSocket_Write", knx%(x%), io%(x%), len%(x%)
  221. len%(x%)=0
  222. ENDPROC
  223.  
  224. DEF PROC_io_filbuf(fdset%)
  225. LOCAL x%
  226. FOR x%=1 TO maxknx%
  227.   IF FN_fd_isset(fdset%,knx%(x%)) PROC_do_o(x%)
  228. NEXT
  229. ENDPROC
  230.  
  231. DEF FN_xlate(p$)
  232. LOCAL p%,q$:q$="":FOR p%=1 TO LENp$
  233. CASE MID$(p$,p%,1) OF
  234.   WHEN "/": q$+="."
  235.   WHEN ".": q$+="/"
  236.   WHEN ":","$","%","&", "^", "*", """", "@", "#", "<", ">": =""
  237.   OTHERWISE: q$+=MID$(p$,p%,1)
  238. ENDCASE
  239. NEXT
  240. =q$
  241.  
  242. DEF PROC_lookup(x%,p$)
  243. LOCAL was_cgi%
  244. IF LEFT$(p$,1) <> "/" p$="/"+p$
  245. was_cgi% = (FN_lower((LEFT$(p$,9))) = "/cgi-bin/")
  246. p$=FN_xlate(p$)
  247. IF p$="" THEN PROC_not_found(x%):PROC_conn_kill(x%):ENDPROC
  248. IF RIGHT$(p$,1) = ".": p$+="index/html"
  249. file$(x%)=lib$+LEFT$(p$,255-LENlib$)
  250. SYS "OS_File", 23, file$(x%) TO obj%,,,,,,type%
  251. PROC_debug(2,file$(x%)+" "+STR$obj%+" "+STR$~type%)
  252. IF obj%=3 obj%=1
  253. IF obj%=2 OR obj%=3 file$(x%)+=".index/html":SYS "OS_File", 23, file$(x%) TO obj%,,,,,,type%
  254. IF obj%<>1 THEN PROC_not_found(x%):PROC_conn_kill(x%):ENDPROC
  255. IF was_cgi% THEN mime$(x%)="":ENDPROC
  256. rocont$(x%)="X-RiscOS-Filetype: "+STR$~type%
  257. CASE type% OF
  258.   WHEN &FAF,&345: mime$(x%)="text/html"
  259.   WHEN &FFF: mime$(x%)="text/plain"
  260.   WHEN &695: mime$(x%)="image/gif"
  261.   WHEN &C85: mime$(x%)="image/jpeg"
  262.   WHEN &AE7: mime$(x%)="video/armovie"
  263.   WHEN &BF8: mime$(x%)="video/mpeg"
  264.   WHEN &FF8,&FFB: mime$(x%)="application/octet-stream"
  265.   WHEN &DDC: mime$(x%)="application/x-sparkive"
  266.   WHEN &3FB, &1000, &2000: mime$(x%)="application/x-arcfs"
  267.   OTHERWISE: PROC_not_found(x%): PROC_conn_kill(x%)
  268. ENDCASE
  269. ENDPROC
  270.  
  271. DEF PROC_authorise(x%,p$)
  272. IF LEFT$(p$,LENroot_pw$) <> root_pw$ THEN PROC_debug(0,"ROOT authentication failed"):ENDPROC
  273. mime$(x%)="application/octet-stream"
  274. file$(x%)=MID$(p$,2+LENroot_pw$)
  275. PROC_debug(0,"ROOT authorisation for "+file$(x%))
  276. ENDPROC
  277.  
  278. DEF PROC_io