Unit HttpTunnels; { This provides an implementation of GenericServerConnection which uses HTTP to get though more firewalls. Earlier versions of the code used HTTP directly. This seemed like a good idea at the time, but each message was different and had different problems. Mostly the problems appeared with different proxy servers. We had no control over these. They were often implemented by the ISP and they were transparent to the user. This code makes everything as simple as possible. No cookies! One big POST request. Even though we are using HTTP for the implementation, the interface is based on TCP/IP. This makes the main part of the code simpler, because it only has to use one interface, a stream of bytes. This can make things more effecient because we can do compression on the entire stream, rather than on each message. And we can put multiple messages into one request to reduce the overhead. On some level this seems silly to me. It seems silly that this is necessary. Some system administrators making things anoying without adding any REAL security. However, we have to deal with this. In fact, this unit is very important. The server connection is implemented with multiple HTTP connections. One connection handles all of the data coming from the server to us. Obviously each HTTP connection has data going in both ways. But I'm talking about the data which the sever sends to us with the expectation that we will forward it to the client of the unit. This HTTP connection also corresponds to the control data in a normal TCP/IP connection. When we first start receiving data from this HTTP connection, we consider the socket open. If this HTTP connection is broken, then the socket is broken. We never send data (except for control data) on this first HTTP connection. We only receive data. By keeping this connection open we can receive data from the server at any time. There does not have to be any connection between the messages that we send to the server and the messages that we receive from the server. When we have bytes of data to send to the server, we send them in a different HTTP connection. We received a magic cookie from the first HTTP connection, and we send that back to let the server know that we are part of the same connection. (This is NOT an HTTP cookie!) We send an HTTP message whenever we have data. The data has already been marshalled into a stream of bytes at this time. One HTTP request can contain several messages to the server, or one message to the server can be broken into multiple HTTP requests. We have a maximum number of bytes that we can send in a request. As soon as we have that many bytes, we send a request. But we can also send a smaller message, if there is no more data currently available. Each of these requests has an id. If there is an error, we resend the request with the same id. The id is required because we cannot be sure if the HTTP server received the message or not. In that case we send a duplicate with the same id. The server can silently ignore a request with a duplicate id. Overall this works well. However, it is noticibly slower than a TCP/IP connection. To see this, try displaying the charts and displaying a lot of alerts. Also, the connection is broken a lot more than with a TCP/IP connection, even with a good network. Finally, the timeouts and are longer so it takes longer to detect and correct a problem. Dispite all of this, it works well, because other parts of the software will automatically retry the connection as required. } Interface Uses GenericServerConnection, WakeMeSoon, OverbyteIcsHttpProt, Classes, ExtCtrls; Type THttpTunnelState = (htsNew, htsConnecting, htsUp, htsDown); TSendState = (ssReadyToSendNew, { The control is free, and so is the buffer. } ssReadyToRepeat, { The control is free, but the buffer is full. } ssSendInProgress, { The control is in use. } ssError); { Something bad happened. We can do no more. } THttpTunnel = Class(TGenericServerConnection) Private FState : THttpTunnelState; FReceiveBuffer, FSendBuffer : String; FNextSequenceNumber : Integer; { We are reusing the same http control to send one message after another. We don't want to step on our own feet. Also, when we do a retry we reuse the same buffer for sending data. } FSendState : TSendState; { The exact need for this is unclear. It appears that we can safely send a new request as soon as we get a successful completion of the last request. It appears, however, that certain errors give us the complete callback before the control is in a good state. I wish I could be more certain, but this problem never happens on my machine. } CheckForSendSoon : TWakeMeSoon; Timer : TTimer; FAbortTime : TDateTime; ReceiveData, SendData : THttpCli; FInitialAddress : String; FPostData : TStringStream; FErrorCount : Integer; Procedure ReceiveDataDocData(Sender : TObject; Buffer : Pointer; Len : Integer); Procedure ReceiveDataRequestDone(Sender : TObject; RqType : THttpRequest; Error : Word); Procedure SendDataRequestDone(Sender : TObject; RqType : THttpRequest; Error : Word); Procedure CheckForSend; Procedure SetProxyInfo(HttpControl : THttpCli); Procedure DoTimer(Sender : TObject); Public Constructor Create(InitialAddress : String); Destructor Destroy; Override; Function Connect : Boolean; Override; Procedure SendStr(S : String); Override; Function GetAll : String; Override; Procedure Close; Override; End; Implementation Uses P64, OverbyteIcsWSocket, MiscDebugWindows, SysUtils, StrUtils; Procedure THttpTunnel.SetProxyInfo(HttpControl : THttpCli); Begin If ProxyServer <> '' Then Begin HttpControl.Proxy := ProxyServer; HttpControl.ProxyPort := IntToStr(ProxyPort); HttpControl.ProxyUsername := ProxyUserName; HttpControl.ProxyPassword := ProxyPassword; HttpControl.SocksServer := ''; HttpControl.SocksPort := ''; HttpControl.SocksUsercode := ''; HttpControl.SocksPassword := ''; HttpControl.SocksAuthentication := socksNoAuthentication End Else If SocksLevel <> '' Then Begin HttpControl.Proxy := ''; HttpControl.ProxyPort := ''; HttpControl.ProxyUsername := ''; HttpControl.ProxyPassword := ''; HttpControl.SocksServer := SocksServer; HttpControl.SocksPort := SocksPort; HttpControl.SocksUsercode := SocksUsercode; HttpControl.SocksPassword := SocksPassword; HttpControl.SocksLevel := SocksLevel; If SocksUsercode = '' Then HttpControl.SocksAuthentication := socksNoAuthentication Else HttpControl.SocksAuthentication := socksAuthenticateUsercode End Else Begin HttpControl.Proxy := ''; HttpControl.ProxyPort := ''; HttpControl.ProxyUsername := ''; HttpControl.ProxyPassword := ''; HttpControl.SocksServer := ''; HttpControl.SocksPort := ''; HttpControl.SocksUsercode := ''; HttpControl.SocksPassword := '' End End; Constructor THttpTunnel.Create(InitialAddress : String); Begin CheckForSendSoon := TWakeMeSoon.Create; CheckForSendSoon.OnWakeUp := CheckForSend; FPostData := TStringStream.Create(''); ReceiveData := THttpCli.Create(Nil); ReceiveData.OnDocData := ReceiveDataDocData; ReceiveData.OnRequestDone := ReceiveDataRequestDone; SendData := THttpCli.Create(Nil); SendData.OnRequestDone := SendDataRequestDone; SendData.SendStream := FPostData; FInitialAddress := InitialAddress; Timer := TTimer.Create(Nil); Timer.Interval := 100; Timer.OnTimer := DoTimer; End; Destructor THttpTunnel.Destroy; Begin Close; ReceiveData.Free; SendData.Free; FPostData.Free; CheckForSendSoon.Free; Timer.Free End; // Return everything we have received from the server since the last call to // this function. Function THttpTunnel.GetAll : String; Begin If FState In [htsUp, htsDown] Then Begin Result := FReceiveBuffer; FReceiveBuffer := '' End // This doesn't look right? The return value is not always initialized! End; Function THttpTunnel.Connect : Boolean; Begin Result := True; Assert(FState = htsNew); FState := htsConnecting; SetProxyInfo(SendData); SetProxyInfo(ReceiveData); ReceiveData.URL := FInitialAddress; Try ReceiveData.GetASync Except // There is a similar TRY block in SocketServerConnections.pas. That // TRY block will receive an error any time that there is a DNS problem. // However, when I test the HTTP Tunnel under the same conditions, I // do not get to this code. In that case we still report an error, but // it is a very generic error. In the socket version, we specifically // tell the user that it is a DNS error. I don't know how to report // a similar error message from this code. PDS On Ex : Exception Do Begin Result := False; FConnectionErrorMessage := 'THttpTunnel.Connect, ' + Ex.ClassName + ', ' + Ex.Message + ', ' + IntToStr(ReceiveData.StatusCode) + ', ' + ReceiveData.ReasonPhrase; Close End End End; Procedure THttpTunnel.ReceiveDataDocData(Sender : TObject; Buffer : Pointer; Len : Integer); Var NewData : String; Seperator : Integer; Temp : String; Begin SetString(NewData, PChar(Buffer), Len); FReceiveBuffer := FReceiveBuffer + NewData; If FState = htsConnecting Then Begin { We are looking for some administrative information, before the part that gets copied back to the client as-is. } Seperator := AnsiPos(#13#10, FReceiveBuffer); If Seperator > 0 Then Begin { The first line is trash. Skip it. (The server sends a lot of filler on the first line. This is used to help us in debugging. MSIE will not display streaming data right away. It will wait until it receives a certain number of bytes before it displays anything.)} Temp := MidStr(FReceiveBuffer, Seperator + 2, MaxInt); Seperator := Pos(#13#10, Temp); If Seperator > 0 Then Begin SendData.URL := LeftBStr(Temp, Pred(Seperator)); FReceiveBuffer := MidBStr(Temp, Seperator + 2, MaxInt); FState := htsUp; If Assigned(OnSessionConnected) Then OnSessionConnected(Self) End End End; If (FState = htsUp) And (Length(FReceiveBuffer) > 0) And Assigned(OnDataAvailable) Then OnDataAvailable(Self) End; Procedure THttpTunnel.SendStr(S : String); Begin Case FState Of htsDown : Begin End; htsUp : Begin FSendBuffer := FSendBuffer + S; CheckForSendSoon.RequestWakeup End; Else { We could buffer this, but for consistancy with the other implemenations, we signal an error. } Assert(False); End End; Procedure THttpTunnel.DoTimer(Sender : TObject); Begin If (FSendState = ssSendInProgress) And (Now > FAbortTime) Then Try SendData.Abort Except End End; Procedure THttpTunnel.CheckForSend; Var NeedToSendSomething : Boolean; SendThisTime : String; Begin NeedToSendSomething := False; Case FSendState Of ssReadyToSendNew : // Our last messge was received and confirmed. We also start in this // state, before we've sent any messages. If Length(FSendBuffer) > 0 Then Begin // Send as many bytes as we can. Don't sent more than 6000 bytes // because that's the max packet size. By sending smaller // packets, we have less chance of failing due to bad HTTP // Proxies. NeedToSendSomething := True; // TO DO: Again, why aren't we using the binary versions! SendThisTime := LeftBStr(FSendBuffer, 6000); FSendBuffer := MidBStr(FSendBuffer, 6001, MaxInt); FPostData.Seek(0, soFromBeginning); FPostData.WriteString('sequence='); FPostData.WriteString(IntToStr(FNextSequenceNumber)); FPostData.WriteString('&body='); FPostData.WriteString(P64.Encode(SendThisTime)) End; // Our last message might have failed. But we are not certain. We have // to resend the data in case the server did not receive it last time. // We have to resend it exactly the same way as last time! If the // server actually did receive the data last time, it will silently // ignore this request. So we can't add anything new to this request. ssReadyToRepeat : NeedToSendSomething := True End; If NeedToSendSomething Then If SendData.State <> httpReady Then Begin { I get here a lot on dan's computer, but not on any of mine! } If {(SendData.StatusCode = 0) And} (SendData.State In [httpDnsLookupDone, httpWaitingHeader]) Then Begin { Ignore this. We will get woken up again soon. } End Else Begin If Assigned(OnAutoRetry) Then OnAutoRetry(Self, 'HTTP Not Ready on Write: ' + IntToStr(SendData.StatusCode) + ', ' + SendData.ReasonPhrase + ', State=' + IntToStr(Ord(SendData.State))); FSendState := ssError; Close End End Else Begin FAbortTime := Now + TimeoutMs / (24.0 * 60.0 * 60.0 * 1000.0); FSendState := ssSendInProgress; FPostData.Seek(0, soFromBeginning); Try SendData.PostASync Except On Ex : Exception Do Begin SendMiscDebugMessage(Ex, 'HttpTunnels, THttpTunnel.CheckForSend'); If Assigned(OnAutoRetry) Then OnAutoRetry(Self, 'Unexpected Exception: THttpTunnel.CheckForSend, ' + Ex.ClassName + ', ' + Ex.Message + ', ' + IntToStr(SendData.StatusCode) + ', ' + SendData.ReasonPhrase); FSendState := ssError; Close End End End End; Procedure THttpTunnel.ReceiveDataRequestDone(Sender : TObject; RqType : THttpRequest; Error : Word); Begin // When the remote server closes the virtual connection, it notifies us // by closing this HTTP session. This could also happen due to some // sort of networking error. In either case, the virtual socket is // closed. If we want to talk to the server again, we have to start // fresh. Close End; Procedure THttpTunnel.SendDataRequestDone(Sender : TObject; RqType : THttpRequest; Error : Word); Begin If SendData.State <> httpReady Then { I don't know what this means. Sometimes we get called back in this state. Previously I called it an error. But that caused a lot of unnecessary disconnects and retries. If I ignore this callback, then everything works perfectly. I've only seen two values of state, httpDnsLookupDone, and httpReady. On httpDnsLookupDone we definately should ignore the event; everything is okay. On httpReady we cannot ignore the event or we will eventually time out. } Exit; FSendState := ssReadyToSendNew; If (Error <> 0) Or (SendData.StatusCode <> 200) Then Begin Inc(FErrorCount); If FErrorCount > 3 Then Begin { If we get here, we should have another message higher up the food chain, but that one will not have the same details with it. } OnAutoRetry(Self, 'ERROR sending data to server: ' + IntToStr(SendData.StatusCode) + ', ' + SendData.ReasonPhrase + ', state: ' + IntToStr(Ord(SendData.State))); Close End Else Begin If Not ((Error = 0) And (SendData.StatusCode = 0)) Then { These messages were more confusing than anything, and they didnt' have any information. } If Assigned(OnAutoRetry) Then OnAutoRetry(Self, 'Error sending data to server: ' + IntToStr(SendData.StatusCode) + ', ' + SendData.ReasonPhrase + ', state: ' + IntToStr(Ord(SendData.State))); FSendState := ssReadyToRepeat; CheckForSendSoon.RequestWakeup // If we retry immediately, sometimes we have problems here. End End Else Begin If FErrorCount > 0 Then Dec(FErrorCount); Inc(FNextSequenceNumber); CheckForSendSoon.RequestWakeup End End; Procedure THttpTunnel.Close; Begin If FState <> htsDown Then Begin If Assigned(ReceiveData) Then Begin ReceiveData.OnDocData := Nil; ReceiveData.OnRequestDone := Nil; ReceiveData.Abort End; If Assigned(SendData) Then Begin SendData.OnRequestDone := Nil; SendData.Abort; FSendState := ssError End; If Assigned(OnSessionClosed) Then OnSessionClosed(Self) End End; End.