PureBoard

Das deutsche PureBasic-Forum
https://www.purebasic.fr/german/

Simpler Proxyserver mit Purebasic - klappt nur nicht. Hilfe!

https://www.purebasic.fr/german/viewtopic.php?t=19319

Seite 1 von 1

Simpler Proxyserver mit Purebasic - klappt nur nicht. Hilfe!

Verfasst: 02.03.2009 20:49
von ramseier
Hallo,

Ich versuche gerade einen simplen portablen Proxyserver zu schreiben.
Um ehrlich zu sein hab ich den legendären Atomic Webserver angepasst.

Nur ergeben sich hier zwei Probleme:

Die Funktionsweise ist wie folgt:

1. Listen nach HTTP-Requests
2. Anpassen des Requests
3. Weiterreichen des Requests an den Zielserver
4. Öffnen einer TCP connection zum Zielserver
5. Rückgabe der Response an den Browser

Leider klappt das mit der TCP-Connection nicht.

Zweites Problem:

Ich habe versucht den Requesthandler als Thread zu starten damit wartende Requests nicht den Gesamtladevorgang bremsen.
Auch hier mache ich was falsch mit dem Allokieren des Speichers.

Könnte bitte mal jemand über den Code schauen und helfende Tips geben?

Code: Alles auswählen

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

Verfasst: 02.03.2009 21:15
von DarkDragon
Ich hab im Mülleimer einen kleinen Icon Replacer gebastelt für phpBB Foren. Ich hab den Fehler dort gefunden und ihn zu einem Puren Proxy umgebastelt:

Code: Alles auswählen

; 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
Der läuft mit Multithreading.

Re: Simpler Proxyserver mit Purebasic - klappt nur nicht. Hi

Verfasst: 02.03.2009 21:44
von Kiffi
ramseier hat geschrieben:Ich versuche gerade einen simplen portablen Proxyserver zu schreiben.
kannste gerne machen. Kannst auch gern hier nachfragen, ob Dir einer
dabei hilft. Aber gleichzeitig im englischen Forum parallel eine Anfrage
starten um somit zwei Usergruppen unabhängig voneinander damit zu
beschäftigen, ist nicht die feine englische Art. :|
Wikipedia hat geschrieben:Ähnlich wie Multipostings im Usenet sind Crosspostings in Webforen nicht
gerne gesehen, da die einzelnen Threads unabhängige Diskussionen
darstellen und im Allgemeinen kein Informationsaustausch zwischen ihnen
stattfindet. Wurde z.B. im einen Thread schon eine Lösung für das Problem
gefunden oder ein entscheidender Hinweis gegeben und im anderen Forum
weiß niemand davon, wird dort u.U. immer noch weiter gerätselt.

@Kiffi

Verfasst: 02.03.2009 22:09
von ramseier
Ahh ich hab schon auf diese Art von Antwort gewartet.

Dieter Nuhr hat ja mal gesagt.. wenn man mal keine sinnvolle Antwort parat hat.. kann man jemanden immernoch irgendwie zurechtweisen.

Ich hätte ja auf die Suchfunktion, Rechtschreibfehler oder einen der anderen 8 typischen Antworten in Foren getippt.

Danke auch dir für diesen wertvollen Hinweis.

@DarkDragon

Verfasst: 02.03.2009 22:13
von ramseier
cooles Teil..

vielen Dank auf jeden Fall..

(das Einfrieren bekomme ich auch noch weg.. liegt bestimmt an meinem Netz hier)

Verfasst: 03.03.2009 10:00
von DarkDragon
Ahja, stimmt - Nachdem alles heruntergeladen wurde friert es ein (Der Webbrowser meint wohl er bekommt noch mehr oder so ähnlich).

Es friert vermutlich ein, da der Webbrowser ein Proxy-Connection: close erwartet oder so (Er sendet ja immerhin Proxy-Connection: keep-alive).

Verfasst: 03.03.2009 17:23
von ramseier
Wie würde denn der Aufruf des ActiveX WinHttpRequest.5.1 aussehen?
Ich muss zwar vorher den Request zerpflücken, kann aber die Response direkt an den Browser weitergeben.
Mit Autoit hatte ich das schon geschafft. Bei Purebasic bin ich da etwas überfragt.
Alle Zeiten sind UTC+02:00
Seite 1 von 1

Powered by phpBB® Forum Software © phpBB Limited

Deutsche Übersetzung durch phpBB.de