PureBasic Forums - English

Posted: **Mon Mar 02, 2009 7:31 pm**

I have modified the legendary Atomic Webserver to act like a very simple HTTP-proxy.
So far so good..

First Problem:

I listen for requests.
I parse the request.
I want to pass the request to the target server.

but.. it doesn't work..

Second Problem:

I've tried to handle the requests multithreaded... but there might be a problem with the memory allocation.

and this is the code:

Code: Select all

Enumeration
  #Window_0
  #Panel_0
  #Editor_0
  #Editor_1
EndEnumeration

Port= 8080
AtomicTitle$   = "Atomic Proxy v1.0"

Global EOL$
EOL$ = Chr(13)+Chr(10)

Procedure.s GetParam (request$,param$)
          Select param$
          Case "Method"
              ReturnVar$ = StringField(request$, 1, " ")
          Case "Path"
              ReturnVar$ = RemoveString(StringField(request$, 2, " "), StringField(StringField(request$, 2, " "),1,"/") + "//" + StringField(StringField(request$, 2, " "),3,"/"))
          Case "Server"
              ReturnVar$ = StringField(StringField(request$, 2, " "),1,"/") + "//" + StringField(StringField(request$, 2, " "),3,"/")
              ReturnVar$ = StringField(ReturnVar$, 1, ":") + ":" + StringField(ReturnVar$, 2, ":")
          Case "RequestOut"
              Host$ = ""
              Server$ = StringField(StringField(request$, 2, " "),1,"/") + "//" + StringField(StringField(request$, 2, " "),3,"/")
              Port$ = StringField(Server$, 3, ":")
              ReturnVar$ = ReplaceString(request$, Server$, Host$)
              ReturnVar$ = RemoveString(ReturnVar$, ":"+Port$)
          Case "Port"
              Server$ = StringField(StringField(request$, 2, " "),1,"/") + "//" + StringField(StringField(request$, 2, " "),3,"/")
              ReturnVar$ = StringField(Server$, 3, ":")
              If ReturnVar$ = ""
                ReturnVar$ = "80"
              EndIf
        EndSelect
  ProcedureReturn ReturnVar$
EndProcedure

Procedure Open_Window_0()
  If OpenWindow(#Window_0, 260, 282, 1065, 687, AtomicTitle$ + " (Port "+Str(Port)+")",  #PB_Window_SystemMenu | #PB_Window_SizeGadget | #PB_Window_TitleBar )
      PanelGadget(#Panel_0, 0, 0, 1070, 690)
      AddGadgetItem(#Panel_0, -1, "Request_in")
      EditorGadget(#Editor_0, 8, 8, 1050, 650)     
      AddGadgetItem(#Panel_0, -1, "Request_out")
      EditorGadget(#Editor_1, 8, 8, 1050, 650)     
  EndIf
EndProcedure

Procedure.l BuildRequestHeader(*Buffer, DataLength.l, ContentType$)

  Length = PokeS(*Buffer, "HTTP/1.1 200 OK"+EOL$)                     : *Buffer+Length
  Length = PokeS(*Buffer, "Date: Wed, 07 Aug 1996 11:15:43 GMT"+EOL$) : *Buffer+Length
  Length = PokeS(*Buffer, "Server: Atomic Web Server 0.2b"+EOL$)      : *Buffer+Length
  Length = PokeS(*Buffer, "Content-Length: "+Str(DataLength)+EOL$)    : *Buffer+Length
  Length = PokeS(*Buffer, "Content-Type: "+ContentType$+EOL$)         : *Buffer+Length
  Length = PokeS(*Buffer, EOL$)                                       : *Buffer+Length

  ProcedureReturn *Buffer
EndProcedure
Procedure ProcessRequests(ClientID)
  *Buffer = AllocateMemory(10000)
  BaseDirectory$ = "www/"
  DefaultPage$ = "Index.html"

  RequestLength.l = ReceiveNetworkData(ClientID, *Buffer, 2000)
  request$ = PeekS(*Buffer)

  SetGadgetText(#Editor_0,GetGadgetText(#Editor_0) + EOL$ + request$)
  SetGadgetText(#Editor_1,GetGadgetText(#Editor_1) + EOL$ + "Server: " + GetParam(request$,"Server"))
  SetGadgetText(#Editor_1,GetGadgetText(#Editor_1) + EOL$ + "Port: " + GetParam(request$,"Port"))
  SetGadgetText(#Editor_1,GetGadgetText(#Editor_1) + EOL$ + GetParam(request$,"RequestOut"))
  server$ = GetParam(request$,"Server")
  RequestOut$ = GetParam(request$,"RequestOut") + EOL$
  port = Val(GetParam(request$,"Port"))
      ConnectionID = OpenNetworkConnection(server$, port)

      If ConnectionID
        *DataBuffer = AllocateMemory(10000)
        SendNetworkString(ConnectionID, RequestOut$)
        ResponseLength.l = ReceiveNetworkData(ConnectionID, *DataBuffer, 10000) 
        SendNetworkData(ClientID, *DataBuffer, ResponseLength.l)
        FreeMemory(*DataBuffer)
      EndIf
  SetGadgetText(#Editor_1,GetGadgetText(#Editor_1) + EOL$ + "ConnectionID = " + server$ + " " + Str(ConnectionID))


         If ReadFile(0, BaseDirectory$+"AtomicWebServer_Error.html")
           FileLength = Lof(0)
           ContentType$ = "text/html"
 
           *FileBuffer   = AllocateMemory(FileLength+200)
           *BufferOffset = BuildRequestHeader(*FileBuffer, FileLength, ContentType$)
 
           ReadData(0, *BufferOffset, FileLength)
           CloseFile(0)
    
           SendNetworkData(ClientID, *FileBuffer, *BufferOffset-*FileBuffer+FileLength)
           FreeMemory(*FileBuffer)
         EndIf
;       EndIf
  ;EndIf
  FreeMemory(*Buffer)
EndProcedure

If InitNetwork() = 0
  MessageRequester("Error", "Can't initialize the network !", 0)
  End
EndIf



If CreateNetworkServer(0, Port)

 Open_Window_0()
  
  Repeat
    
    Repeat
      WEvent = WindowEvent()

      If WEvent = #PB_Event_CloseWindow : Quit = 1 : EndIf
    Until WEvent = 0
    
    SEvent = NetworkServerEvent()
  
    If SEvent
      ClientID.l = EventClient()
  
      Select SEvent
      
        Case 1  ; When a new client has been connected...
        Case 4  ; When a client has closed the connection...
        Default
          ProcessRequests(ClientID)
;          CreateThread(@ProcessRequests(),ClientID) <---------------- this would start the requesthandler as multithread.. if it would work.. :-(
          
      EndSelect

    Else
      Delay(20)  ; Don't stole the whole CPU !
    EndIf
    
  Until Quit = 1 
    
  CloseNetworkServer(0)
Else
  MessageRequester(AtomicTitle$, "Error: can't create the server (port in use ?).", 0)
EndIf
  
End

[/quote]

Posted: **Mon Mar 02, 2009 8:18 pm**

Some days ago I wanted a hello kitty extension for the german purebasic board. Then I decided to do a webproxy for me, which replaces a phpBB icon.

Now here is the pure webproxy part:

Code: Select all

; Made by Daniel Brall ('DarkDragon') - http://www.bradan.eu/

#PORT = 6666
#BUFFER_SIZE = 1024 * 32 ; 32 kbytes

Structure SREQUEST
  request.s
  sendBackId.i
EndStructure

Procedure GetHTTP(*request.SREQUEST)
  Protected firstLine.s, newFirstLine.s, line.s
  Protected newRequest.s
  Protected host.s, file.s
  Protected connectionId
  Protected k
  Protected *buffer
  Protected bytesReceived

  If *request\request <> "" And *request\sendBackId <> 0

    firstLine = StringField(*request\request, 1, #CRLF$)
    newFirstLine = firstLine

    While FindString(newFirstLine, "  ", 1)
      newFirstLine = ReplaceString(newFirstLine, "  ", " ")
    Wend

    host = StringField(newFirstLine, 2, " ")
    file = Right(host, Len(host) + 1 - (FindString(host, "/", FindString(host, "/", 1) + 2)))
    host = StringField(host, 3, "/")

    If host <> ""

      If FindString(host, ":", 1) = 0
        connectionId = OpenNetworkConnection(host, 80)
      Else
        connectionId = OpenNetworkConnection(StringField(host, 1, ":"), Val(StringField(host, 2, ":")))
      EndIf

      If connectionId

        newFirstLine = StringField(newFirstLine, 1, " ") + " " + file + " HTTP/1.0"
        newRequest = newFirstLine + #CRLF$

        For k = 2 To CountString(*request\request, #CRLF$)
          line = RemoveString(RemoveString(StringField(*request\request, k, #CRLF$), #CR$), #LF$)
          If LCase(Left(line, Len("Accept-Encoding:"))) = LCase("Accept-Encoding:")
            line = "Accept-Encoding: "
          EndIf

          newRequest + line + #CRLF$
        Next k
        
        PrintN("New request: ")
        PrintN(newRequest)

        SendNetworkData(connectionId, @newRequest, Len(newRequest) + 1)

        *buffer = AllocateMemory(#BUFFER_SIZE)

        Repeat
          While NetworkClientEvent(connectionId) <> #PB_NetworkEvent_Data
            Delay(1)
          Wend

          bytesReceived = ReceiveNetworkData(connectionId, *buffer, #BUFFER_SIZE)

          If bytesReceived > 0
            SendNetworkData(*request\sendBackId, *buffer, bytesReceived)
          EndIf

          If bytesReceived < 0
            Break
          EndIf
        ForEver

        FreeMemory(*buffer)
      EndIf

    EndIf

  EndIf

  FreeMemory(*request)
EndProcedure

Define *request.SREQUEST
Define *buffer

*buffer = AllocateMemory(#BUFFER_SIZE)


If InitNetwork()

  OpenConsole()

  If CreateNetworkServer(0, #PORT)

    PrintN("Server created at port " + Str(#PORT))

    PrintN("Press escape to close the server.")

    Repeat
      Select NetworkServerEvent()
        Case #PB_NetworkEvent_Data
          *request            = AllocateMemory(SizeOf(SREQUEST))
          *request\sendBackId = EventClient()

          ReceiveNetworkData(*request\sendBackId, *buffer, #BUFFER_SIZE)

          *request\request = PeekS(*buffer)

          CreateThread(@GetHTTP(), *request)
        Default
          Delay(2)
      EndSelect
    Until Inkey() = Chr(27)

    CloseNetworkServer(0)

  EndIf

  CloseConsole()

EndIf

I'm doing the Hello Kitty extension!!!
It's multithreaded.

Posted: **Mon Mar 02, 2009 8:38 pm**

cool.. thank you..

unfortunately the request freezes..

strange.. even if it's multithreaded..

Posted: **Fri Jun 12, 2009 9:39 pm**

Hello,

I think this sample is very good! Know anybody a sample which is bigger and has more features?

Thanks!

Yours,
codeman!

PureBasic Forums - English

Simpleproxy - quite simple but doesn't work.. please help..

Simpleproxy - quite simple but doesn't work.. please help..