with trace --trace(1) sequence serverdir=current_dir() function setworkpath(sequence intext) -- peu : [workdir/].. +[ parameters ] -- php : [workdir/].. .php[ parameters ] -- php : [workdir/].. [%20].. - [%20].. .php[ parameters ] -- file: [workdir/].. .ext integer index=0 for i=1 to length(intext) do if find(intext[i],"+%-.") then index=i exit end if end for if index then for i=index to 1 by -1 do if intext[i]='/' then index=i exit else index=0 end if end for end if if index then ~change_dir(intext[1..index-1]) else ~change_dir(serverdir) end if -- printf(1,"Current work dir -> %s \n",{current_dir()}) return intext[index+1..] end function function remove_all(sequence intext;teken ) integer j=find(teken,intext) integer klad=1 while j do klad+=j-1 intext=intext[1..klad-1]&intext[klad+1..-1] j=find(teken,intext[klad..-1]) end while return intext end function function replace_all(sequence intext;teken;door ) integer j=find(teken,intext) integer klad=0 while j do intext[j+klad]=door klad=j j=find(teken,intext[j+1..-1]) end while return intext end function function convert_ascii(sequence intext) integer hex=find('%',intext),klad=0 sequence hexval while hex do hex=klad+hex hexval=value('#'&intext[hex+1..hex+2]) intext=intext[1..hex-1]&hexval[2]&intext[hex+3..-1] klad=hex hex=find('%',intext[hex+1..-1]) end while return intext end function -- response header of HTTP procedure response_HTTP(atom client, sequence text) integer klad -- geen declaratie dan crashed de zaak -- status response header puts(client,"HTTP/1.1 200 OK\r\n") -- general response header -- puts(client,"server:menno_http\r\n") puts(client,"Cache-Control:no-cache\r\n") -- puts(client,"Set-Cookie: rss=feed1\r\n") puts(client,"Connection:close\r\n") -- entity header if sequence(text) --voorkomt fouten in server then klad=match("",lower(text)) else klad=0 end if if klad then puts(client,"Content-Type: text/html \r\n") else puts(client,"Content-Type: text/plain\r\n") end if -- empty line puts(client,"\r\n") end procedure procedure send_picture(integer client,sequence text,integer file) puts(client,"HTTP/1.1 200 OK\r\n") -- general response header puts(client,"Cache-Control:no-cache\r\n") puts(client,"Connection:close\r\n") -- entity header puts(client,"Content-Type: image/"&text&" \r\n") -- empty line puts(client,"\r\n") text=getc(file) while text!=-1 do putc(client,text) text=getc(file) end while end procedure -- main program atom server atom client atom file sequence text , buffer ,posttext integer telezen,klad,content_type constant LINUX=3 sequence exeprog,htmldefault if platform()=LINUX then exeprog="peul " htmldefault="rssframe.html" else exeprog="peuw " htmldefault="rssframe.html" end if server=open("127.0.0.1:5000","s") if server<0 then puts(1,"error in open server\n") abort(1) end if if platform()=LINUX then system("defaultbrowser http://127.0.0.1:5000/rssframe.html &",1) -- start in background else system("c:\\progra~1\\Mozill~1\\firefox http://127.0.0.1:5000/rssframe.html",1) -- system("c:\\progra~1\\intern~1\\iexplore http://127.0.0.1:5000/rssframe.html",1) end if while 1 do client = open(server,"a") if client<0 then puts(1,"error in accept\n") abort(1) end if -- /* lees van client */ text = gets(client) buffer = {} -- html protocol eindigd met een lege regel while sequence(text) and text[1]!=13 and text[1]!=10 do printf(1,"%s",{text}) buffer=append(buffer,text) text = gets(client) end while text="" -- /* response op HTML */ if "GET"=buffer[1][1..3] then text= buffer[1][6 .. match(" HTTP",buffer[1])-1] --zet naar workdir text=setworkpath(text) klad=find('?',text) if klad then buffer=text[klad..] text =text[1..klad-1] -- in huidige versie worden de commando's omgezet in een parameterlijst -- formeel is dit een x-www-form-urlencoded text ?=[&=] -- dit wordt omgezet in [ ] buffer = replace_all(buffer,'=',' ') buffer = replace_all(buffer,'&',' ') buffer = convert_ascii(buffer) else buffer = "" -- hiermee zijn de client gegevens weg ! end if elsif "POST"=buffer[1][1..4] then text= buffer[1][7 .. match(" HTTP",buffer[1])-1] --zet naar workdir text=setworkpath(text) --lees data content_type=0 for i=2 to length(buffer) do klad = match("CONTENT-TYPE:",upper(buffer[i])) if klad != 0 then klad=match(":",buffer[i]) if match("plain",buffer[i][klad+1..]) then content_type=1 -- Konqueror heeft de eigenschap er een boundary achter -- tezeten met als in hmtlboundary hetgeen wil zeggen -- x-www-form- is . waarom weet ik niet if match("KHTMLBOUNDARY",upper(buffer[i][klad+1..])) then content_type=0 end if elsif match("data",buffer[i][klad+1..]) then content_type=2 end if end if end for -- Content-Type : application/x-www-form-urlencoded -- Content-Type : text/plain -- Content-Type : multipart/form-data -- en POST heeft in Content-Length: het aantal nog te lezen character staan telezen={0,0} for i=2 to length(buffer) do klad = match("CONTENT-LENGTH:",upper(buffer[i])) if klad then klad=match(":",buffer[i]) telezen=value(buffer[i][klad+1..-2]) exit end if end for buffer ="" posttext="" file=open("post.cmd","w") if content_type=1 then -- plain if telezen[2] then printf(1,"POST -plain with %d bytes\n",{telezen[2]}) while telezen[2] do posttext=gets(client) if sequence(posttext) then -- geeft bij stop een -2 puts(file,posttext) telezen[2]-=length(posttext)+1 -- gets sloopt cr else telezen[2]=0 end if end while else -- blijkt Netscape te doen posttext=gets(client) while posttext[1]!=13 and posttext[1]!=10 do puts(file,posttext) --puts(file,remove_all(posttext,'\r')) posttext=gets(client) end while end if elsif content_type=2 then -- form-data if telezen[2] then printf(1,"POST form-data with %d bytes\n",{telezen[2]}) while telezen[2] do posttext=gets(client) if sequence(posttext) -- bij stop een -2 then puts(file,posttext) telezen[2]-=length(posttext)+1 -- i.v.m. cr else telezen[2]=0 end if end while else -- blijkt Netscape te doen posttext=gets(client) while posttext[1]!=13 and posttext[1]!=10 do puts(file,posttext) posttext=gets(client) end while end if else -- urlencoded for i= 1 to telezen[2] do posttext &= getc(client) end for -- printf(1,"->%s\n",{posttext}) -- replace + by space posttext=replace_all(posttext,'+',' ') -- replace & by cr\lf in unix/linux only lf posttext=replace_all(posttext,'&','\n') posttext=convert_ascii(posttext) -- printf(1,"->%s\n",{posttext}) puts(file,posttext&'\n') end if close(file) else text="" puts(1,"nog niet bekende opdracht\n") end if -- /* schrijf file naar client */ if length(text) then -- sloop alle ? en = (kan '?' in POST ?) text=replace_all(text,'?',' ') text=replace_all(text,'=',' ') text=convert_ascii(text) puts(1,text) -- bekijk of het een php executebel is if match(".php",text) then -- replace + spatie , eventueel %20 -> spatie text=replace_all(text,'+',' ') text="c:\\php\\php -q "&text&" >agenda.htm" system(text,0) text="agenda.htm" file=open(text,"r") -- kijk of het een peuw executebel is elsif find('+',text) then -- replace + spatie , eventueel %20 -> spatie text=replace_all(text,'+',' ') text=exeprog&text&buffer -- buffer geeft aditionele parameters system(text,0) text="agenda.htm" file=open(text,"r") -- bekijk of het een commando is of een file elsif find('.',text) then file = open(text,"rb") else file = 0 if text="quit" then --puts(client,"Server closed\n") response_HTTP(client,"") puts(client,"

Server Beeindigd") puts(client,"

Bedankt voor het gebruik

Het programma is beeindigd .

U kunt dit venster sluiten

") close(client) exit else response_HTTP(client,"") puts(client,"Onbekent commando : "&text&"\n") end if end if else file = open(htmldefault,"r") -- default end if if file=-1 then response_HTTP(client,"") puts(client,"File ") puts(client,text) puts(client," not found") puts(1,"file "&text&" not found\n") elsif file>0 then if match(".jpg",text) then send_picture(client,"jpg",file) elsif match(".gif",text) then send_picture(client,"gif",file) else if match(".htm",text) then text = gets(file) response_HTTP(client,"") else text = gets(file) -- kijk of de inhoud van de file een HTML is response_HTTP(client,text) end if if sequence(text) then while sequence(text) do --printf(1,"length = %d \n",{length(text)}) --printf(client,"%s",{text}) --geeft buffer fouten puts(client,text) text = gets(file) end while else puts(client," Sorry a error : application try to send a empty file\r\n") end if end if close(file) end if -- /*close client */ close(client) end while close(server) abort(1)