├── Source ├── AsyncIO.pas ├── AsyncIO.OpResults.pas ├── AsyncIO.Coroutine.Detail.pas ├── AsyncIO.Filesystem.pas ├── AsyncIO.Filesystem.Detail.pas ├── AsyncIO.Net.IP.Detail.pas ├── AsyncIO.StreamReader.pas ├── AsyncIO.Coroutine.Net.IP.pas ├── AsyncIO.Detail.StreamBufferImpl.pas ├── AsyncIO.Coroutine.pas └── AsyncIO.Coroutine.Detail.Fiber.pas ├── dev ├── AsyncIODev.res ├── TestData.txt ├── AsyncIO.Test.StreamReader.pas ├── AsyncIODev.dpr ├── AsyncIO.Test.AsyncReadUntil.pas ├── AsyncIO.Test.Basic.pas ├── AsyncIO.Test.Copy.pas └── AsyncIO.Test.Socket.pas ├── Test ├── AsyncIOTests.res ├── AsyncIOTestCase.pas ├── NetTestCase.pas ├── AsyncIOTests.dpr ├── EchoTestClient.pas ├── EchoTestServer.pas ├── Test.AsyncIO.Net.IP.Detail.pas ├── IPStreamSocketMock.pas └── Test.AsyncIO.Net.IP.Detail.TCPImpl.pas ├── Examples ├── HTTP │ ├── AsyncHttpClient.res │ ├── AsyncHttpServer.res │ ├── AsyncHttpServer.ConnectionManager.pas │ ├── AsyncHttpServer.Request.pas │ ├── AsyncHttpServer.ficfg │ ├── AsyncHttpServer.Mime.pas │ ├── AsyncHttpClient.dpr │ ├── AsyncHttpServer.Headers.pas │ ├── HttpDateTime.pas │ ├── AsyncHttpServer.Impl.pas │ ├── AsyncHttpServer.Response.pas │ ├── AsyncHttpServer.dpr │ ├── AsyncHttpClient.Impl.pas │ ├── AsyncHttpServer.RequestHandler.pas │ ├── AsyncHttpServer.RequestParser.pas │ └── AsyncHttpServer.Connection.pas ├── FileCopy │ ├── AsyncFileCopy.res │ ├── AsyncFileCopy.dpr │ └── AsyncFileCopy.Impl.pas └── TCPEcho │ ├── AsyncEchoClient.res │ ├── AsyncEchoClient.dpr │ └── AsyncEchoClient.Impl.pas ├── .gitignore ├── .gitattributes ├── README.md ├── AsyncIO.groupproj └── LICENSE /Source/AsyncIO.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/lordcrc/AsyncIO/HEAD/Source/AsyncIO.pas -------------------------------------------------------------------------------- /dev/AsyncIODev.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/lordcrc/AsyncIO/HEAD/dev/AsyncIODev.res -------------------------------------------------------------------------------- /Test/AsyncIOTests.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/lordcrc/AsyncIO/HEAD/Test/AsyncIOTests.res -------------------------------------------------------------------------------- /dev/TestData.txt: -------------------------------------------------------------------------------- 1 | This is a test 2 | 1234567890 3 | 4 | More test lines 5 | One two three 6 | -------------------------------------------------------------------------------- /Source/AsyncIO.OpResults.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/lordcrc/AsyncIO/HEAD/Source/AsyncIO.OpResults.pas -------------------------------------------------------------------------------- /Examples/HTTP/AsyncHttpClient.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/lordcrc/AsyncIO/HEAD/Examples/HTTP/AsyncHttpClient.res -------------------------------------------------------------------------------- /Examples/HTTP/AsyncHttpServer.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/lordcrc/AsyncIO/HEAD/Examples/HTTP/AsyncHttpServer.res -------------------------------------------------------------------------------- /Examples/FileCopy/AsyncFileCopy.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/lordcrc/AsyncIO/HEAD/Examples/FileCopy/AsyncFileCopy.res -------------------------------------------------------------------------------- /Examples/TCPEcho/AsyncEchoClient.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/lordcrc/AsyncIO/HEAD/Examples/TCPEcho/AsyncEchoClient.res -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | ############ 2 | # Delphi 3 | ############ 4 | __history 5 | *.dcu 6 | *.~*~ 7 | *.local 8 | *.identcache 9 | *.drc 10 | *.map 11 | *.exe 12 | *.dll 13 | *.tds 14 | *.rsm 15 | *.dsk 16 | *.~dsk 17 | *.dsm 18 | *.cbk 19 | *.stat 20 | TestInsightSettings.ini 21 | *.tvsconfig 22 | Examples/HTTP/www/ 23 | -------------------------------------------------------------------------------- /Examples/HTTP/AsyncHttpServer.ConnectionManager.pas: -------------------------------------------------------------------------------- 1 | unit AsyncHttpServer.ConnectionManager; 2 | 3 | interface 4 | 5 | uses 6 | AsyncHttpServer.Connection; 7 | 8 | 9 | implementation 10 | 11 | procedure RemoveHttpConnection(const Connection: HttpConnection; const ConnectionManager: HttpConnectionManager); 12 | begin 13 | 14 | end; 15 | 16 | end. 17 | -------------------------------------------------------------------------------- /Source/AsyncIO.Coroutine.Detail.pas: -------------------------------------------------------------------------------- 1 | unit AsyncIO.Coroutine.Detail; 2 | 3 | interface 4 | 5 | uses 6 | AsyncIO, AsyncIO.OpResults; 7 | 8 | type 9 | CoroutineFiber = interface 10 | ['{EDF6A454-9887-4605-A84C-CFB6F07E7F4D}'] 11 | procedure SwitchTo; 12 | end; 13 | 14 | IYieldContext = interface 15 | procedure Wait; 16 | procedure SetServiceHandlerCoroutine; 17 | end; 18 | 19 | implementation 20 | 21 | 22 | end. 23 | -------------------------------------------------------------------------------- /Examples/HTTP/AsyncHttpServer.Request.pas: -------------------------------------------------------------------------------- 1 | unit AsyncHttpServer.Request; 2 | 3 | interface 4 | 5 | uses 6 | AsyncHttpServer.Headers; 7 | 8 | type 9 | HttpRequest = record 10 | Method: string; 11 | URI: string; 12 | HttpVersionMajor: integer; 13 | HttpVersionMinor: integer; 14 | Headers: HttpHeaders; 15 | end; 16 | 17 | function NewHttpRequest: HttpRequest; 18 | 19 | implementation 20 | 21 | function NewHttpRequest: HttpRequest; 22 | begin 23 | result.HttpVersionMajor := 0; 24 | result.HttpVersionMinor := 0; 25 | end; 26 | 27 | end. 28 | -------------------------------------------------------------------------------- /.gitattributes: -------------------------------------------------------------------------------- 1 | # Auto detect text files and perform LF normalization 2 | * text=auto 3 | 4 | # Custom for Visual Studio 5 | *.cs diff=csharp 6 | *.sln merge=union 7 | *.csproj merge=union 8 | *.vbproj merge=union 9 | *.fsproj merge=union 10 | *.dbproj merge=union 11 | 12 | # Delphi 13 | *.dproj merge=union 14 | 15 | # Standard to msysgit 16 | *.doc diff=astextplain 17 | *.DOC diff=astextplain 18 | *.docx diff=astextplain 19 | *.DOCX diff=astextplain 20 | *.dot diff=astextplain 21 | *.DOT diff=astextplain 22 | *.pdf diff=astextplain 23 | *.PDF diff=astextplain 24 | *.rtf diff=astextplain 25 | *.RTF diff=astextplain 26 | -------------------------------------------------------------------------------- /Test/AsyncIOTestCase.pas: -------------------------------------------------------------------------------- 1 | unit AsyncIOTestCase; 2 | 3 | interface 4 | 5 | uses 6 | System.SysUtils, TestFramework, AsyncIO.OpResults; 7 | 8 | type 9 | TAsyncIOTestCase = class(TTestCase) 10 | public 11 | procedure CheckEquals(expected, actual: OpResult; msg: string = ''); overload; virtual; 12 | end; 13 | 14 | 15 | implementation 16 | 17 | { TAsyncIOTestCase } 18 | 19 | procedure TAsyncIOTestCase.CheckEquals(expected, actual: OpResult; msg: string); 20 | begin 21 | FCheckCalled := True; 22 | if (expected <> actual) then 23 | FailNotEquals(expected.Message, actual.Message, msg); 24 | end; 25 | 26 | end. 27 | -------------------------------------------------------------------------------- /Source/AsyncIO.Filesystem.pas: -------------------------------------------------------------------------------- 1 | unit AsyncIO.Filesystem; 2 | 3 | interface 4 | 5 | uses 6 | AsyncIO; 7 | 8 | type 9 | FileAccess = (faRead, faWrite, faReadWrite); 10 | 11 | FileCreationDisposition = (fcCreateNew, fcCreateAlways, fcOpenExisting, fcOpenAlways, fcTruncateExisting); 12 | 13 | FileShareMode = (fsNone, fsDelete, fsRead, fsWrite, fsReadWrite); 14 | 15 | function NewAsyncFileStream(const Service: IOService; 16 | const Filename: string; 17 | const CreationDisposition: FileCreationDisposition; 18 | const Access: FileAccess; 19 | const ShareMode: FileShareMode): AsyncFileStream; 20 | 21 | implementation 22 | 23 | uses 24 | AsyncIO.Filesystem.Detail; 25 | 26 | function NewAsyncFileStream(const Service: IOService; 27 | const Filename: string; 28 | const CreationDisposition: FileCreationDisposition; 29 | const Access: FileAccess; 30 | const ShareMode: FileShareMode): AsyncFileStream; 31 | begin 32 | result := AsyncFileStreamImpl.Create( 33 | Service, Filename, CreationDisposition, Access, ShareMode 34 | ); 35 | end; 36 | 37 | end. 38 | -------------------------------------------------------------------------------- /dev/AsyncIO.Test.StreamReader.pas: -------------------------------------------------------------------------------- 1 | unit AsyncIO.Test.StreamReader; 2 | 3 | interface 4 | 5 | procedure RunStreamReaderTest; 6 | 7 | implementation 8 | 9 | uses 10 | System.SysUtils, System.Classes, AsyncIO.StreamReader; 11 | 12 | 13 | function unc(const s: string): string; 14 | begin 15 | result := TEncoding.UTF8.GetString(TEncoding.UTF8.GetBytes(s)); 16 | end; 17 | 18 | procedure Test1; 19 | var 20 | s1, s2, s3: string; 21 | r1, r2, r3, r4: string; 22 | enc: TEncoding; 23 | b: TBytes; 24 | bs: TBytesStream; 25 | sr: StreamReader; 26 | begin 27 | s1 := 'This is a test'; 28 | s2 := 'Это тест'; 29 | s3 := 'これはテストです'; 30 | 31 | enc := TEncoding.UTF8; 32 | 33 | b := enc.GetBytes(s1 + #13#10 + s2 + #13#10 + #13#10 + s3); 34 | 35 | bs := TBytesStream.Create(b); 36 | sr := NewStreamReader(enc, bs, True); 37 | 38 | r1 := sr.ReadLine; 39 | r2 := sr.ReadLine; 40 | r4 := sr.ReadLine; 41 | r3 := sr.ReadLine; 42 | 43 | if (not SameStr(r1, s1)) then 44 | WriteLn('Test1 error, r1 <> s1'); 45 | if (not SameStr(r2, s2)) then 46 | WriteLn('Test1 error, r2 <> s2'); 47 | if (not SameStr(r3, s3)) then 48 | WriteLn('Test1 error, r3 <> s3'); 49 | if (not SameStr(r4, '')) then 50 | WriteLn('Test1 error, r4 <> '''''); 51 | end; 52 | 53 | procedure RunStreamReaderTest; 54 | begin 55 | Test1; 56 | end; 57 | 58 | end. 59 | -------------------------------------------------------------------------------- /dev/AsyncIODev.dpr: -------------------------------------------------------------------------------- 1 | program AsyncIODev; 2 | 3 | {$APPTYPE CONSOLE} 4 | 5 | {$R *.res} 6 | 7 | uses 8 | System.SysUtils, 9 | AsyncIO.Test.Basic in 'AsyncIO.Test.Basic.pas', 10 | AsyncIO.Test.Copy in 'AsyncIO.Test.Copy.pas', 11 | AsyncIO.Test.Socket in 'AsyncIO.Test.Socket.pas', 12 | AsyncIO.Test.StreamReader in 'AsyncIO.Test.StreamReader.pas', 13 | AsyncIO.Test.AsyncReadUntil in 'AsyncIO.Test.AsyncReadUntil.pas', 14 | AsyncIO.Detail in '..\Source\AsyncIO.Detail.pas', 15 | AsyncIO.Detail.StreamBufferImpl in '..\Source\AsyncIO.Detail.StreamBufferImpl.pas', 16 | AsyncIO.OpResults in '..\Source\AsyncIO.OpResults.pas', 17 | AsyncIO.Filesystem.Detail in '..\Source\AsyncIO.Filesystem.Detail.pas', 18 | AsyncIO.Filesystem in '..\Source\AsyncIO.Filesystem.pas', 19 | AsyncIO.Net.IP.Detail in '..\Source\AsyncIO.Net.IP.Detail.pas', 20 | AsyncIO.Net.IP.Detail.TCPImpl in '..\Source\AsyncIO.Net.IP.Detail.TCPImpl.pas', 21 | AsyncIO.Net.IP in '..\Source\AsyncIO.Net.IP.pas', 22 | AsyncIO in '..\Source\AsyncIO.pas', 23 | AsyncIO.StreamReader in '..\Source\AsyncIO.StreamReader.pas', 24 | BufStream in '..\..\BufferedStreamReader\BufStream.pas', 25 | BufStreamReader in '..\..\BufferedStreamReader\BufStreamReader.pas', 26 | EncodingHelper in '..\..\BufferedStreamReader\EncodingHelper.pas', 27 | RegularExpr.Detail in '..\..\RegularExpr\RegularExpr.Detail.pas', 28 | RegularExpr in '..\..\RegularExpr\RegularExpr.pas'; 29 | 30 | begin 31 | ReportMemoryLeaksOnShutdown := True; 32 | try 33 | // RunBasicTest; 34 | // RunCopyTest; 35 | RunSocketTest; 36 | // RunStreamReaderTest; 37 | except 38 | on E: Exception do 39 | Writeln(E.ClassName, ': ', E.Message); 40 | end; 41 | ReadLn; 42 | end. 43 | -------------------------------------------------------------------------------- /Examples/HTTP/AsyncHttpServer.ficfg: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 100 6 | 7 | 8 | 7 9 | 10 | 11 | 10 12 | 13 | 14 | 15 | 16 | 17 | true 18 | true 19 | false 20 | false 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | true 42 | true 43 | true 44 | 45 | 46 | 47 | 48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57 | 58 | 59 | true 60 | 61 | 62 | -------------------------------------------------------------------------------- /Examples/TCPEcho/AsyncEchoClient.dpr: -------------------------------------------------------------------------------- 1 | program AsyncEchoClient; 2 | 3 | {$APPTYPE CONSOLE} 4 | 5 | {$R *.res} 6 | 7 | uses 8 | System.SysUtils, 9 | AsyncIO.Detail in '..\..\Source\AsyncIO.Detail.pas', 10 | AsyncIO.Detail.StreamBufferImpl in '..\..\Source\AsyncIO.Detail.StreamBufferImpl.pas', 11 | AsyncIO.OpResults in '..\..\Source\AsyncIO.OpResults.pas', 12 | AsyncIO.Net.IP.Detail in '..\..\Source\AsyncIO.Net.IP.Detail.pas', 13 | AsyncIO.Net.IP.Detail.TCPImpl in '..\..\Source\AsyncIO.Net.IP.Detail.TCPImpl.pas', 14 | AsyncIO.Net.IP in '..\..\Source\AsyncIO.Net.IP.pas', 15 | AsyncIO in '..\..\Source\AsyncIO.pas', 16 | AsyncEchoClient.Impl in 'AsyncEchoClient.Impl.pas'; 17 | 18 | procedure PrintUsage; 19 | begin 20 | WriteLn('Usage:'); 21 | WriteLn; 22 | WriteLn(' AsyncEchoClient host [port]'); 23 | WriteLn; 24 | WriteLn(' host Echo server hostname'); 25 | WriteLn(' port Port, default 7'); 26 | WriteLn; 27 | end; 28 | 29 | procedure Run(const Host: string; const Port: integer); 30 | var 31 | ios: IOService; 32 | echoClient: AsyncTCPEchoClient; 33 | progressHandler: EchoClientProgressHandler; 34 | data: TBytes; 35 | r: Int64; 36 | begin 37 | progressHandler := 38 | procedure(const Status: string) 39 | begin 40 | WriteLn(Status); 41 | end; 42 | 43 | data := TEncoding.UTF8.GetBytes('AsyncEchoClient test'); 44 | 45 | ios := NewIOService(); 46 | echoClient := NewAsyncTCPEchoClient(ios, progressHandler); 47 | 48 | echoClient.Execute(data, Host, Port); 49 | 50 | r := ios.Run; 51 | 52 | WriteLn; 53 | WriteLn(Format('%d handlers executed', [r])); 54 | end; 55 | 56 | var 57 | host: string; 58 | port: integer; 59 | begin 60 | try 61 | if (ParamCount() < 1) then 62 | PrintUsage 63 | else 64 | begin 65 | host := ParamStr(1); 66 | 67 | if (ParamCount() < 2) then 68 | port := 7 69 | else 70 | port := StrToInt(ParamStr(2)); 71 | 72 | Run(host, port); 73 | end; 74 | except 75 | on E: Exception do 76 | Writeln(E.ClassName, ': ', E.Message); 77 | end; 78 | end. 79 | -------------------------------------------------------------------------------- /Source/AsyncIO.Filesystem.Detail.pas: -------------------------------------------------------------------------------- 1 | unit AsyncIO.Filesystem.Detail; 2 | 3 | interface 4 | 5 | uses 6 | AsyncIO, AsyncIO.Detail, AsyncIO.Filesystem; 7 | 8 | type 9 | AsyncFileStreamImpl = class(AsyncHandleStreamImpl, AsyncFileStream) 10 | private 11 | FFilename: string; 12 | public 13 | constructor Create(const Service: IOService; const Filename: string; 14 | const CreationDisposition: FileCreationDisposition; 15 | const Access: FileAccess; const ShareMode: FileShareMode); 16 | 17 | function GetFilename: string; 18 | end; 19 | 20 | implementation 21 | 22 | uses 23 | WinAPI.Windows, System.SysUtils; 24 | 25 | { AsyncFileStreamImpl } 26 | 27 | constructor AsyncFileStreamImpl.Create(const Service: IOService; 28 | const Filename: string; const CreationDisposition: FileCreationDisposition; 29 | const Access: FileAccess; const ShareMode: FileShareMode); 30 | const 31 | AccessMapping: array[FileAccess] of DWORD = (GENERIC_READ, GENERIC_WRITE, GENERIC_READ or GENERIC_WRITE); 32 | CreationDispositionMapping: array[FileCreationDisposition] of DWORD = (CREATE_NEW, CREATE_ALWAYS, OPEN_EXISTING, OPEN_ALWAYS, TRUNCATE_EXISTING); 33 | ShareModeMapping: array[FileShareMode] of DWORD = (0, FILE_SHARE_DELETE, FILE_SHARE_READ, FILE_SHARE_WRITE, FILE_SHARE_READ or FILE_SHARE_WRITE); 34 | var 35 | fh: THandle; 36 | ac, sm, cd, flags: DWORD; 37 | begin 38 | ac := AccessMapping[Access]; 39 | sm := ShareModeMapping[ShareMode]; 40 | cd := CreationDispositionMapping[CreationDisposition]; 41 | 42 | flags := FILE_ATTRIBUTE_NORMAL or FILE_FLAG_OVERLAPPED; 43 | 44 | fh := CreateFile(PChar(Filename), ac, sm, nil, cd, flags, 0); 45 | 46 | if (fh = INVALID_HANDLE_VALUE) then 47 | RaiseLastOSError(GetLastError(), #13#10 + 'Filename: "' + Filename + '"'); 48 | 49 | // call create here 50 | // so that the handle is closed if the 51 | // CreateIoCompletionPort call below fails 52 | inherited Create(Service, fh); 53 | 54 | FFilename := Filename; 55 | IOServiceAssociateHandle(Service, fh); 56 | end; 57 | 58 | function AsyncFileStreamImpl.GetFilename: string; 59 | begin 60 | result := FFilename; 61 | end; 62 | 63 | end. 64 | -------------------------------------------------------------------------------- /Test/NetTestCase.pas: -------------------------------------------------------------------------------- 1 | unit NetTestCase; 2 | 3 | interface 4 | 5 | uses 6 | System.SysUtils, TestFramework, AsyncIOTestCase, AsyncIO.Net.IP; 7 | 8 | type 9 | TNetTestCase = class(TAsyncIOTestCase) 10 | protected 11 | function GenerateData(const Length: integer): TBytes; 12 | public 13 | procedure CheckEquals(expected, actual: IPv4Address; msg: string = ''); overload; virtual; 14 | procedure CheckEquals(expected, actual: IPv6Address; msg: string = ''); overload; virtual; 15 | procedure CheckEquals(expected, actual: IPAddress; msg: string = ''); overload; virtual; 16 | procedure CheckEquals(expected, actual: IPEndpoint; msg: string = ''); overload; virtual; 17 | procedure CheckEquals(expected, actual: IPProtocol; msg: string = ''); overload; virtual; 18 | end; 19 | 20 | 21 | implementation 22 | 23 | { TNetTestCase } 24 | 25 | function TNetTestCase.GenerateData(const Length: integer): TBytes; 26 | var 27 | i: integer; 28 | begin 29 | SetLength(result, Length); 30 | 31 | RandSeed := 1001; 32 | for i := 0 to Length-1 do 33 | begin 34 | result[i] := Random(256); 35 | end; 36 | end; 37 | 38 | procedure TNetTestCase.CheckEquals(expected, actual: IPv4Address; msg: string); 39 | begin 40 | FCheckCalled := True; 41 | if (expected <> actual) then 42 | FailNotEquals(expected, actual, msg); 43 | end; 44 | 45 | procedure TNetTestCase.CheckEquals(expected, actual: IPv6Address; msg: string); 46 | begin 47 | FCheckCalled := True; 48 | if (expected <> actual) then 49 | FailNotEquals(expected, actual, msg); 50 | end; 51 | 52 | procedure TNetTestCase.CheckEquals(expected, actual: IPAddress; msg: string); 53 | begin 54 | FCheckCalled := True; 55 | if (expected <> actual) then 56 | FailNotEquals(expected, actual, msg); 57 | end; 58 | 59 | procedure TNetTestCase.CheckEquals(expected, actual: IPEndpoint; msg: string); 60 | begin 61 | FCheckCalled := True; 62 | if (expected <> actual) then 63 | FailNotEquals(expected, actual, msg); 64 | end; 65 | 66 | procedure TNetTestCase.CheckEquals(expected, actual: IPProtocol; msg: string); 67 | begin 68 | FCheckCalled := True; 69 | if (expected <> actual) then 70 | FailNotEquals(expected.ToString, actual.ToString, msg); 71 | end; 72 | 73 | end. 74 | -------------------------------------------------------------------------------- /Examples/FileCopy/AsyncFileCopy.dpr: -------------------------------------------------------------------------------- 1 | program AsyncFileCopy; 2 | 3 | {$APPTYPE CONSOLE} 4 | 5 | {$R *.res} 6 | 7 | uses 8 | System.SysUtils, 9 | System.DateUtils, 10 | System.Math, 11 | AsyncIO.Detail.StreamBufferImpl in '..\..\Source\AsyncIO.Detail.StreamBufferImpl.pas', 12 | AsyncIO.Detail in '..\..\Source\AsyncIO.Detail.pas', 13 | AsyncIO.OpResults in '..\..\Source\AsyncIO.OpResults.pas', 14 | AsyncIO.Filesystem.Detail in '..\..\Source\AsyncIO.Filesystem.Detail.pas', 15 | AsyncIO.Filesystem in '..\..\Source\AsyncIO.Filesystem.pas', 16 | AsyncIO in '..\..\Source\AsyncIO.pas', 17 | AsyncFileCopy.Impl in 'AsyncFileCopy.Impl.pas', 18 | AsyncIO.Coroutine in '..\..\Source\AsyncIO.Coroutine.pas', 19 | AsyncIO.Coroutine.Detail in '..\..\Source\AsyncIO.Coroutine.Detail.pas', 20 | AsyncIO.Coroutine.Detail.Fiber in '..\..\Source\AsyncIO.Coroutine.Detail.Fiber.pas'; 21 | 22 | procedure PrintUsage; 23 | begin 24 | WriteLn('Usage:'); 25 | WriteLn; 26 | WriteLn(' AsyncFileCopy source dest'); 27 | WriteLn; 28 | WriteLn(' source Source filename'); 29 | WriteLn(' dest Destination filename'); 30 | WriteLn; 31 | end; 32 | 33 | procedure Run(const SourceFilename, DestFilename: string); 34 | var 35 | ios: IOService; 36 | copier: AsyncFileCopier; 37 | progressHandler: IOProgressHandler; 38 | startTime: TDateTime; 39 | begin 40 | progressHandler := 41 | procedure(const TotalBytesRead, TotalBytesWritten: UInt64; const ReadBPS, WriteBPS: double) 42 | var 43 | totalEleapsedMSec: UInt64; 44 | avgTotalBPS: double; 45 | begin 46 | totalEleapsedMSec := MilliSecondsBetween(Now(), startTime); 47 | 48 | avgTotalBPS := (TotalBytesRead + TotalBytesWritten) / (2e3 * Max(1, totalEleapsedMSec)); 49 | 50 | Write(Format(#13'Read: %3d MB (%.2f MB/s) | Written: %3d MB (%.2f MB/s) | Avg: %.2f MB/s ', 51 | [TotalBytesRead shr 20, ReadBPS, TotalBytesWritten shr 20, WriteBPS, avgTotalBPS])); 52 | end; 53 | 54 | ios := NewIOService(); 55 | copier := NewAsyncFileCopier(ios, progressHandler, 4096); 56 | 57 | startTime := Now(); 58 | copier.Execute(SourceFilename, DestFilename); 59 | end; 60 | 61 | begin 62 | try 63 | if (ParamCount() < 2) then 64 | PrintUsage 65 | else 66 | Run(ParamStr(1), ParamStr(2)); 67 | except 68 | on E: Exception do 69 | Writeln(E.ClassName, ': ', E.Message); 70 | end; 71 | end. 72 | -------------------------------------------------------------------------------- /dev/AsyncIO.Test.AsyncReadUntil.pas: -------------------------------------------------------------------------------- 1 | unit AsyncIO.Test.AsyncReadUntil; 2 | 3 | interface 4 | 5 | procedure RunAsyncReadUntilDelimTest; 6 | 7 | implementation 8 | 9 | uses 10 | System.SysUtils, System.Classes, 11 | AsyncIO, AsyncIO.ErrorCodes, AsyncIO.Filesystem; 12 | 13 | type 14 | FileReader = class 15 | private 16 | FInputStream: AsyncFileStream; 17 | FOutputStream: TStringStream; 18 | FBuffer: StreamBuffer; 19 | procedure HandleRead(const ErrorCode: IOErrorCode; const BytesTransferred: UInt64); 20 | public 21 | constructor Create(const Service: IOService; const Filename: string); 22 | end; 23 | 24 | 25 | procedure RunAsyncReadUntilDelimTest; 26 | var 27 | inputFilename: string; 28 | ios: IOService; 29 | reader: FileReader; 30 | r: Int64; 31 | begin 32 | ios := nil; 33 | reader := nil; 34 | try 35 | ios := NewIOService(); 36 | 37 | inputFilename := ParamStr(1); 38 | 39 | if (inputFilename = '') then 40 | raise Exception.Create('Missing command line parameter'); 41 | 42 | reader := FileReader.Create(ios, inputFilename); 43 | 44 | r := ios.Run; 45 | 46 | WriteLn(Format('%d handlers executed', [r])); 47 | 48 | finally 49 | reader.Free; 50 | end; 51 | end; 52 | 53 | { FileReader } 54 | 55 | constructor FileReader.Create(const Service: IOService; const Filename: string); 56 | begin 57 | inherited Create; 58 | 59 | FInputStream := NewAsyncFileStream(Service, Filename, fcOpenExisting, faRead, fsNone); 60 | FOutputStream := TStringStream.Create('', TEncoding.ASCII, False); 61 | FBuffer := StreamBuffer.Create(); 62 | 63 | AsyncReadUntil(FInputStream, FBuffer, [13, 10], HandleRead); 64 | end; 65 | 66 | procedure FileReader.HandleRead(const ErrorCode: IOErrorCode; const BytesTransferred: UInt64); 67 | begin 68 | // if (ErrorCode) then 69 | // begin 70 | // if (ErrorCode = IOErrorCode.EndOfFile) then 71 | // begin 72 | // WriteLn(Format('Finished reading %d bytes from file', [FBytesRead])); 73 | // exit; 74 | // end; 75 | // 76 | // WriteLn('Error: ' + ErrorCode.Message); 77 | // exit; 78 | // end; 79 | 80 | if (ErrorCode <> IOErrorCode.EndOfFile) then 81 | begin 82 | WriteLn('Error: ' + ErrorCode.Message); 83 | FInputStream.Service.Stop; 84 | exit; 85 | end; 86 | 87 | WriteLn(Format('Read %d bytes from file', [BytesTransferred])); 88 | 89 | FInputStream.Service.Stop; 90 | end; 91 | 92 | end. 93 | -------------------------------------------------------------------------------- /Test/AsyncIOTests.dpr: -------------------------------------------------------------------------------- 1 | program AsyncIOTests; 2 | { 3 | 4 | Delphi DUnit Test Project 5 | ------------------------- 6 | This project contains the DUnit test framework and the GUI/Console test runners. 7 | Add "CONSOLE_TESTRUNNER" to the conditional defines entry in the project options 8 | to use the console test runner. Otherwise the GUI test runner will be used by 9 | default. 10 | 11 | } 12 | 13 | {$IFDEF CONSOLE_TESTRUNNER} 14 | {$APPTYPE CONSOLE} 15 | {$ENDIF} 16 | 17 | uses 18 | {$IFDEF TESTINSIGHT} 19 | TestInsight.Client, 20 | TestInsight.DUnit, 21 | {$ENDIF } 22 | DUnitTestRunner, 23 | RegularExpr.Detail in '..\..\RegularExpr\RegularExpr.Detail.pas', 24 | RegularExpr in '..\..\RegularExpr\RegularExpr.pas', 25 | BufStream in '..\..\BufferedStreamReader\BufStream.pas', 26 | BufStreamReader in '..\..\BufferedStreamReader\BufStreamReader.pas', 27 | EncodingHelper in '..\..\BufferedStreamReader\EncodingHelper.pas', 28 | AsyncIO.Detail in '..\Source\AsyncIO.Detail.pas', 29 | AsyncIO.Detail.StreamBufferImpl in '..\Source\AsyncIO.Detail.StreamBufferImpl.pas', 30 | AsyncIO.OpResults in '..\Source\AsyncIO.OpResults.pas', 31 | AsyncIO.Filesystem.Detail in '..\Source\AsyncIO.Filesystem.Detail.pas', 32 | AsyncIO.Filesystem in '..\Source\AsyncIO.Filesystem.pas', 33 | AsyncIO.Net.IP.Detail in '..\Source\AsyncIO.Net.IP.Detail.pas', 34 | AsyncIO.Net.IP.Detail.TCPImpl in '..\Source\AsyncIO.Net.IP.Detail.TCPImpl.pas', 35 | AsyncIO.Net.IP in '..\Source\AsyncIO.Net.IP.pas', 36 | AsyncIO in '..\Source\AsyncIO.pas', 37 | AsyncIO.StreamReader in '..\Source\AsyncIO.StreamReader.pas', 38 | NetTestCase in 'NetTestCase.pas', 39 | IPStreamSocketMock in 'IPStreamSocketMock.pas', 40 | EchoTestServer in 'EchoTestServer.pas', 41 | Test.AsyncIO.Detail in 'Test.AsyncIO.Detail.pas', 42 | Test.AsyncIO.Net.IP in 'Test.AsyncIO.Net.IP.pas', 43 | Test.AsyncIO.Net.IP.Detail.TCPImpl in 'Test.AsyncIO.Net.IP.Detail.TCPImpl.pas', 44 | Test.AsyncIO.Net.IP.Detail in 'Test.AsyncIO.Net.IP.Detail.pas', 45 | EchoTestClient in 'EchoTestClient.pas', 46 | AsyncIOTestCase in 'AsyncIOTestCase.pas'; 47 | 48 | {$R *.RES} 49 | 50 | {$IFDEF TESTINSIGHT} 51 | function IsTestInsightRunning: Boolean; 52 | var 53 | client: ITestInsightClient; 54 | begin 55 | client := TTestInsightRestClient.Create; 56 | client.StartedTesting(0); 57 | Result := not client.HasError; 58 | end; 59 | 60 | begin 61 | if IsTestInsightRunning then 62 | TestInsight.DUnit.RunRegisteredTests 63 | else 64 | DUnitTestRunner.RunRegisteredTests; 65 | {$ELSE} 66 | begin 67 | DUnitTestRunner.RunRegisteredTests; 68 | {$ENDIF} 69 | end. 70 | 71 | 72 | -------------------------------------------------------------------------------- /dev/AsyncIO.Test.Basic.pas: -------------------------------------------------------------------------------- 1 | unit AsyncIO.Test.Basic; 2 | 3 | interface 4 | 5 | procedure RunBasicTest; 6 | 7 | implementation 8 | 9 | uses 10 | System.SysUtils, AsyncIO, AsyncIO.ErrorCodes, AsyncIO.Filesystem; 11 | 12 | type 13 | FileScanner = class 14 | private 15 | FBuffer: TBytes; 16 | FStream: AsyncFileStream; 17 | FBytesRead: Int64; 18 | procedure DoReadData; 19 | procedure ReadHandler(const ErrorCode: IOErrorCode; const BytesTransferred: UInt64); 20 | public 21 | constructor Create(const Service: IOService; const Filename: string); 22 | end; 23 | 24 | 25 | procedure RunBasicTest; 26 | var 27 | inputFilename: string; 28 | ios: IOService; 29 | scanner: FileScanner; 30 | r: Int64; 31 | begin 32 | ios := nil; 33 | scanner := nil; 34 | try 35 | ios := NewIOService(); 36 | 37 | inputFilename := ParamStr(1); 38 | 39 | if (inputFilename = '') then 40 | raise Exception.Create('Missing command line parameter'); 41 | 42 | scanner := FileScanner.Create(ios, inputFilename); 43 | 44 | ios.Post( 45 | procedure 46 | begin 47 | WriteLn('One'); 48 | end 49 | ); 50 | ios.Post( 51 | procedure 52 | begin 53 | WriteLn('Two'); 54 | end 55 | ); 56 | 57 | r := ios.Poll; 58 | 59 | WriteLn(Format('%d handlers executed', [r])); 60 | 61 | finally 62 | scanner.Free; 63 | end; 64 | end; 65 | 66 | { FileScanner } 67 | 68 | constructor FileScanner.Create(const Service: IOService; const Filename: string); 69 | begin 70 | inherited Create; 71 | 72 | SetLength(FBuffer, 4*1024*1024); 73 | FStream := NewAsyncFileStream(Service, Filename, fcOpenExisting, faRead, fsNone); 74 | 75 | Service.Post( 76 | procedure 77 | begin 78 | DoReadData; 79 | end 80 | ); 81 | end; 82 | 83 | procedure FileScanner.DoReadData; 84 | begin 85 | FStream.AsyncReadSome(FBuffer, ReadHandler); 86 | end; 87 | 88 | procedure FileScanner.ReadHandler(const ErrorCode: IOErrorCode; const BytesTransferred: UInt64); 89 | begin 90 | if (ErrorCode) then 91 | begin 92 | if (ErrorCode = IOErrorCode.EndOfFile) then 93 | begin 94 | WriteLn(Format('Finished reading %d bytes from file', [FBytesRead])); 95 | exit; 96 | end; 97 | 98 | WriteLn('Error: ' + ErrorCode.Message); 99 | exit; 100 | end; 101 | 102 | FBytesRead := FBytesRead + BytesTransferred; 103 | WriteLn(Format('Read %d bytes from file (total %d MB)', [BytesTransferred, FBytesRead shr 20])); 104 | 105 | DoReadData; 106 | end; 107 | 108 | end. 109 | -------------------------------------------------------------------------------- /Examples/HTTP/AsyncHttpServer.Mime.pas: -------------------------------------------------------------------------------- 1 | unit AsyncHttpServer.Mime; 2 | 3 | interface 4 | 5 | type 6 | MimeRegistry = interface 7 | ['{66E11440-29E8-4D27-B7BF-2D8D1EA52540}'] 8 | 9 | function DefaultMimeType: string; 10 | function FileExtensionToMimeType(const Extension: string): string; 11 | end; 12 | 13 | function NewMimeRegistry: MimeRegistry; 14 | 15 | implementation 16 | 17 | uses 18 | Winapi.Windows, System.SysUtils, System.Win.Registry, 19 | System.Generics.Collections; 20 | 21 | type 22 | MimeRegistryImpl = class(TInterfacedObject, MimeRegistry) 23 | strict private 24 | FLookupCache: TDictionary; 25 | FRegistry: TRegistry; 26 | public 27 | constructor Create; 28 | destructor Destroy; override; 29 | 30 | function DefaultMimeType: string; 31 | function FileExtensionToMimeType(const Extension: string): string; 32 | end; 33 | 34 | function NewMimeRegistry: MimeRegistry; 35 | begin 36 | result := MimeRegistryImpl.Create; 37 | end; 38 | 39 | { MimeRegistryImpl } 40 | 41 | constructor MimeRegistryImpl.Create; 42 | begin 43 | inherited Create; 44 | 45 | FLookupCache := TDictionary.Create; 46 | FRegistry := TRegistry.Create; 47 | FRegistry.RootKey := HKEY_CLASSES_ROOT; 48 | end; 49 | 50 | function MimeRegistryImpl.DefaultMimeType: string; 51 | begin 52 | result := 'text/plain'; 53 | end; 54 | 55 | destructor MimeRegistryImpl.Destroy; 56 | begin 57 | FLookupCache.Free; 58 | FRegistry.Free; 59 | 60 | inherited; 61 | end; 62 | 63 | function MimeRegistryImpl.FileExtensionToMimeType( 64 | const Extension: string): string; 65 | var 66 | ext: string; 67 | validExtension: boolean; 68 | cachedValue: boolean; 69 | hasRegEntry: boolean; 70 | begin 71 | validExtension := (Extension.StartsWith('.')); 72 | if (not validExtension) then 73 | raise EArgumentException.CreateFmt('Invalid file extension: "%s"', [Extension]); 74 | 75 | // keep it simple 76 | ext := Extension.ToLower; 77 | 78 | cachedValue := FLookupCache.TryGetValue(ext, result); 79 | if (cachedValue) then 80 | exit; 81 | 82 | // default is blank, meaning unknown 83 | result := ''; 84 | 85 | hasRegEntry := FRegistry.OpenKeyReadOnly(ext); 86 | if (not hasRegEntry) then 87 | exit; 88 | 89 | try 90 | // returns blank if no Content Type value 91 | result := FRegistry.ReadString('Content Type'); 92 | 93 | if (result <> '') then 94 | FLookupCache.Add(ext, result); 95 | finally 96 | FRegistry.CloseKey; 97 | end; 98 | end; 99 | 100 | end. 101 | -------------------------------------------------------------------------------- /Test/EchoTestClient.pas: -------------------------------------------------------------------------------- 1 | unit EchoTestClient; 2 | 3 | interface 4 | 5 | uses 6 | System.Threading; 7 | 8 | type 9 | IEchoTestClient = interface 10 | function GetPort: integer; 11 | function GetHost: string; 12 | 13 | function ConnectAndSend(const s: string): IFuture; 14 | 15 | property Port: integer read GetPort; 16 | property Host: string read GetHost; 17 | end; 18 | 19 | function NewEchoTestClient(const Host: string; const Port: integer): IEchoTestClient; 20 | 21 | implementation 22 | 23 | uses 24 | IdEcho, IdException, System.SysUtils, IdGlobal, IdStack; 25 | 26 | type 27 | TEchoTestServerImpl = class(TInterfacedObject, IEchoTestClient) 28 | private 29 | FClient: TIdEcho; 30 | FCurrent: IFuture; 31 | public 32 | constructor Create(const Host: string; const Port: integer); 33 | destructor Destroy; override; 34 | 35 | function GetPort: integer; 36 | function GetHost: string; 37 | 38 | procedure Shutdown; 39 | 40 | function ConnectAndSend(const s: string): IFuture; 41 | end; 42 | 43 | 44 | function NewEchoTestClient(const Host: string; const Port: integer): IEchoTestClient; 45 | begin 46 | result := TEchoTestServerImpl.Create(Host, Port); 47 | end; 48 | 49 | { TEchoTestServerImpl } 50 | 51 | function TEchoTestServerImpl.ConnectAndSend(const s: string): IFuture; 52 | begin 53 | if ((FCurrent <> nil) and (FCurrent.Status <> TTaskStatus.Completed)) then 54 | raise EInvalidOpException.Create('ConnectAndSend: already in progress'); 55 | 56 | FCurrent := TTask.Future( 57 | function: string 58 | begin 59 | FClient.Connect; 60 | 61 | result := FClient.Echo(s); 62 | 63 | Shutdown(); 64 | end 65 | ); 66 | 67 | FCurrent.Start; 68 | 69 | result := FCurrent; 70 | end; 71 | 72 | constructor TEchoTestServerImpl.Create(const Host: string; const Port: integer); 73 | begin 74 | inherited Create; 75 | 76 | FClient := TIdEcho.Create(nil); 77 | FClient.Host := Host; 78 | FClient.Port := Port; 79 | FClient.IPVersion := Id_IPv6; 80 | 81 | FCurrent := nil; 82 | end; 83 | 84 | destructor TEchoTestServerImpl.Destroy; 85 | begin 86 | if (FCurrent <> nil) then 87 | begin 88 | FCurrent.Wait(); 89 | end; 90 | 91 | inherited; 92 | end; 93 | 94 | function TEchoTestServerImpl.GetHost: string; 95 | begin 96 | result := FClient.Host; 97 | end; 98 | 99 | function TEchoTestServerImpl.GetPort: integer; 100 | begin 101 | result := FClient.Port; 102 | end; 103 | 104 | procedure TEchoTestServerImpl.Shutdown; 105 | begin 106 | try 107 | FClient.Disconnect(True); 108 | except 109 | on E: EIdSilentException do; 110 | end; 111 | end; 112 | 113 | end. 114 | -------------------------------------------------------------------------------- /Source/AsyncIO.Net.IP.Detail.pas: -------------------------------------------------------------------------------- 1 | unit AsyncIO.Net.IP.Detail; 2 | 3 | interface 4 | 5 | uses 6 | IdWinsock2, AsyncIO, AsyncIO.Detail, AsyncIO.OpResults, AsyncIO.Net.IP; 7 | 8 | const 9 | //#define SO_UPDATE_CONNECT_CONTEXT 0x7010 10 | SO_UPDATE_CONNECT_CONTEXT = $7010; 11 | 12 | type 13 | IPSocketAccess = interface 14 | ['{05B1639C-2E59-4174-B18B-43E2B40F1E50}'] 15 | procedure Assign(const Protocol: IPProtocol; const SocketHandle: TSocket); 16 | end; 17 | 18 | procedure IPSocketAssign(const Socket: IPSocket; const Protocol: IPProtocol; const SocketHandle: TSocket); 19 | 20 | type 21 | AsyncSocketStreamImpl = class(AsyncStreamImplBase, AsyncSocketStream) 22 | private 23 | FSocket: IPStreamSocket; 24 | public 25 | constructor Create(const Socket: IPStreamSocket); 26 | destructor Destroy; override; 27 | 28 | function GetSocket: IPStreamSocket; 29 | 30 | procedure AsyncReadSome(const Buffer: MemoryBuffer; const Handler: IOHandler); override; 31 | procedure AsyncWriteSome(const Buffer: MemoryBuffer; const Handler: IOHandler); override; 32 | 33 | property Socket: IPStreamSocket read FSocket; 34 | end; 35 | 36 | function DefaultConnectCondition(const Res: OpResult; const Endpoint: IPEndpoint): boolean; 37 | 38 | // result helpers 39 | function WinsockResult(const ResultValue: integer): OpResult; 40 | function GetAddrResult(const ResultValue: integer): OpResult; 41 | 42 | implementation 43 | 44 | procedure IPSocketAssign(const Socket: IPSocket; const Protocol: IPProtocol; const SocketHandle: TSocket); 45 | var 46 | socketAccess: IPSocketAccess; 47 | begin 48 | socketAccess := Socket as IPSocketAccess; 49 | socketAccess.Assign(Protocol, SocketHandle); 50 | end; 51 | 52 | function DefaultConnectCondition(const Res: OpResult; const Endpoint: IPEndpoint): boolean; 53 | begin 54 | result := True; 55 | end; 56 | 57 | function WinsockResult(const ResultValue: integer): OpResult; 58 | begin 59 | if (ResultValue = SOCKET_ERROR) then 60 | result := NetResults.LastError 61 | else 62 | result := NetResults.Success; 63 | end; 64 | 65 | function GetAddrResult(const ResultValue: integer): OpResult; 66 | begin 67 | if (ResultValue <> 0) then 68 | result := NetResults.LastError 69 | else 70 | result := NetResults.Success; 71 | end; 72 | 73 | { AsyncSocketStreamImpl } 74 | 75 | procedure AsyncSocketStreamImpl.AsyncReadSome(const Buffer: MemoryBuffer; 76 | const Handler: IOHandler); 77 | begin 78 | Socket.AsyncReceive(Buffer, Handler); 79 | end; 80 | 81 | procedure AsyncSocketStreamImpl.AsyncWriteSome(const Buffer: MemoryBuffer; 82 | const Handler: IOHandler); 83 | begin 84 | Socket.AsyncSend(Buffer, Handler); 85 | end; 86 | 87 | constructor AsyncSocketStreamImpl.Create(const Socket: IPStreamSocket); 88 | begin 89 | inherited Create(Socket.Service); 90 | 91 | FSocket := Socket; 92 | end; 93 | 94 | destructor AsyncSocketStreamImpl.Destroy; 95 | begin 96 | 97 | inherited; 98 | end; 99 | 100 | function AsyncSocketStreamImpl.GetSocket: IPStreamSocket; 101 | begin 102 | result := FSocket; 103 | end; 104 | 105 | end. 106 | -------------------------------------------------------------------------------- /Test/EchoTestServer.pas: -------------------------------------------------------------------------------- 1 | unit EchoTestServer; 2 | 3 | interface 4 | 5 | uses 6 | System.SysUtils; 7 | 8 | type 9 | IEchoTestServer = interface 10 | function GetPort: integer; 11 | function GetReceivedData: TBytes; 12 | 13 | procedure Start; 14 | procedure Stop; 15 | 16 | 17 | property Port: integer read GetPort; 18 | end; 19 | 20 | function NewEchoTestServer(const Port: integer): IEchoTestServer; 21 | 22 | implementation 23 | 24 | uses 25 | IdGlobal, IdContext, IdIOHandler, IdCustomTCPServer; 26 | 27 | type 28 | TEchoServer = class(TIdCustomTCPServer) 29 | private 30 | FData: TBytes; 31 | 32 | procedure SetData(const Data: TBytes); 33 | protected 34 | function DoExecute(AContext:TIdContext): boolean; override; 35 | 36 | function GetData: TBytes; 37 | end; 38 | 39 | { TEchoServer } 40 | 41 | function TEchoServer.DoExecute(AContext: TIdContext): boolean; 42 | var 43 | LBuffer: TIdBytes; 44 | Data: TBytes; 45 | LIOHandler: TIdIOHandler; 46 | begin 47 | Result := True; 48 | SetLength(LBuffer, 0); 49 | LIOHandler := AContext.Connection.IOHandler; 50 | LIOHandler.ReadBytes(LBuffer, -1); 51 | 52 | SetLength(Data, Length(LBuffer)); 53 | Move(LBuffer[0], Data[0], Length(LBuffer)); 54 | SetData(Data); 55 | 56 | LIOHandler.Write(LBuffer); 57 | end; 58 | 59 | function TEchoServer.GetData: TBytes; 60 | begin 61 | TMonitor.Enter(Self); 62 | try 63 | result := Copy(FData); 64 | finally 65 | TMonitor.Exit(Self); 66 | end; 67 | end; 68 | 69 | procedure TEchoServer.SetData(const Data: TBytes); 70 | begin 71 | TMonitor.Enter(Self); 72 | try 73 | FData := FData + Data; 74 | finally 75 | TMonitor.Exit(Self); 76 | end; 77 | end; 78 | 79 | type 80 | TEchoTestServerImpl = class(TInterfacedObject, IEchoTestServer) 81 | private 82 | FServer: TECHOServer; 83 | public 84 | constructor Create(const Port: integer); 85 | destructor Destroy; override; 86 | 87 | procedure Start; 88 | procedure Stop; 89 | 90 | function GetPort: integer; 91 | function GetReceivedData: TBytes; 92 | end; 93 | 94 | function NewEchoTestServer(const Port: integer): IEchoTestServer; 95 | begin 96 | result := TEchoTestServerImpl.Create(Port); 97 | end; 98 | 99 | { TEchoTestServerImpl } 100 | 101 | constructor TEchoTestServerImpl.Create(const Port: integer); 102 | begin 103 | inherited Create; 104 | 105 | FServer := TECHOServer.Create(nil); 106 | FServer.DefaultPort := Port; 107 | FServer.MaxConnections := 1; 108 | end; 109 | 110 | destructor TEchoTestServerImpl.Destroy; 111 | begin 112 | FServer.Free; 113 | 114 | inherited; 115 | end; 116 | 117 | function TEchoTestServerImpl.GetPort: integer; 118 | begin 119 | result := FServer.DefaultPort; 120 | end; 121 | 122 | function TEchoTestServerImpl.GetReceivedData: TBytes; 123 | begin 124 | result := FServer.GetData; 125 | end; 126 | 127 | procedure TEchoTestServerImpl.Start; 128 | begin 129 | FServer.Active := True; 130 | 131 | // Give the server threads some time to start listening 132 | Sleep(100); 133 | end; 134 | 135 | procedure TEchoTestServerImpl.Stop; 136 | begin 137 | FServer.Active := False; 138 | end; 139 | 140 | end. 141 | -------------------------------------------------------------------------------- /Test/Test.AsyncIO.Net.IP.Detail.pas: -------------------------------------------------------------------------------- 1 | unit Test.AsyncIO.Net.IP.Detail; 2 | { 3 | 4 | Delphi DUnit Test Case 5 | ---------------------- 6 | This unit contains a skeleton test case class generated by the Test Case Wizard. 7 | Modify the generated code to correctly setup and call the methods from the unit 8 | being tested. 9 | 10 | } 11 | 12 | interface 13 | 14 | uses 15 | TestFramework, AsyncIO.Net.IP.Detail, AsyncIO.Net.IP, AsyncIO.Detail, AsyncIO, NetTestCase; 16 | 17 | type 18 | // Test methods for class AsyncSocketStreamImpl 19 | 20 | TestAsyncSocketStreamImpl = class(TNetTestCase) 21 | strict private 22 | FService: IOService; 23 | FSocket: IPStreamSocket; 24 | FAsyncSocketStreamImpl: AsyncSocketStream; 25 | FHandlerExecuted: boolean; 26 | public 27 | procedure SetUp; override; 28 | procedure TearDown; override; 29 | published 30 | procedure TestGetSocket; 31 | procedure TestAsyncReadSome; 32 | procedure TestAsyncWriteSome; 33 | end; 34 | 35 | implementation 36 | 37 | uses 38 | IPStreamSocketMock, AsyncIO.OpResults; 39 | 40 | procedure TestAsyncSocketStreamImpl.SetUp; 41 | begin 42 | FService := NewIOService; 43 | FSocket := TIPStreamSocketMock.Create(FService); 44 | 45 | FSocket.Bind(Endpoint(IPAddressFamily.v4, 0)); 46 | FSocket.Connect(Endpoint(IPv4Address.Loopback, 54321)); 47 | 48 | FAsyncSocketStreamImpl := NewAsyncSocketStream(FSocket); 49 | 50 | FHandlerExecuted := False; 51 | end; 52 | 53 | procedure TestAsyncSocketStreamImpl.TearDown; 54 | begin 55 | FAsyncSocketStreamImpl := nil; 56 | FSocket := nil; 57 | FService := nil; 58 | end; 59 | 60 | procedure TestAsyncSocketStreamImpl.TestGetSocket; 61 | var 62 | ReturnValue: IPStreamSocket; 63 | begin 64 | ReturnValue := FAsyncSocketStreamImpl.GetSocket; 65 | 66 | CheckSame(FSocket, ReturnValue); 67 | end; 68 | 69 | procedure TestAsyncSocketStreamImpl.TestAsyncReadSome; 70 | var 71 | Handler: IOHandler; 72 | Buffer: MemoryBuffer; 73 | data: TArray; 74 | begin 75 | SetLength(data, 42); 76 | Buffer := data; 77 | 78 | Handler := 79 | procedure(const Res: OpResult; const BytesTransferred: UInt64) 80 | begin 81 | FHandlerExecuted := True; 82 | CheckTrue(Res.Success, 'Error: ' + Res.Message); 83 | CheckEquals(42, BytesTransferred, 'BytesTransferred incorrect'); 84 | end; 85 | 86 | FAsyncSocketStreamImpl.AsyncReadSome(Buffer, Handler); 87 | 88 | FService.Poll; 89 | 90 | CheckTrue(FHandlerExecuted, 'Handler failed to execute'); 91 | end; 92 | 93 | procedure TestAsyncSocketStreamImpl.TestAsyncWriteSome; 94 | var 95 | Handler: IOHandler; 96 | Buffer: MemoryBuffer; 97 | data: TArray; 98 | begin 99 | SetLength(data, 42); 100 | Buffer := data; 101 | 102 | Handler := 103 | procedure(const Res: OpResult; const BytesTransferred: UInt64) 104 | begin 105 | FHandlerExecuted := True; 106 | CheckTrue(Res.Success, 'Error: ' + Res.Message); 107 | CheckEquals(42, BytesTransferred, 'BytesTransferred incorrect'); 108 | end; 109 | 110 | FAsyncSocketStreamImpl.AsyncWriteSome(Buffer, Handler); 111 | 112 | FService.Poll; 113 | 114 | CheckTrue(FHandlerExecuted, 'Handler failed to execute'); 115 | end; 116 | 117 | 118 | initialization 119 | // Register any test cases with the test runner 120 | RegisterTest(TestAsyncSocketStreamImpl.Suite); 121 | end. 122 | 123 | -------------------------------------------------------------------------------- /Examples/HTTP/AsyncHttpClient.dpr: -------------------------------------------------------------------------------- 1 | program AsyncHttpClient; 2 | 3 | {$APPTYPE CONSOLE} 4 | 5 | {$R *.res} 6 | 7 | uses 8 | System.SysUtils, 9 | System.Classes, 10 | BufStream in '..\..\..\BufferedStreamReader\BufStream.pas', 11 | BufStreamReader in '..\..\..\BufferedStreamReader\BufStreamReader.pas', 12 | EncodingHelper in '..\..\..\BufferedStreamReader\EncodingHelper.pas', 13 | RegularExpr.Detail in '..\..\..\RegularExpr\RegularExpr.Detail.pas', 14 | RegularExpr in '..\..\..\RegularExpr\RegularExpr.pas', 15 | AsyncIO.Detail in '..\..\Source\AsyncIO.Detail.pas', 16 | AsyncIO.Detail.StreamBufferImpl in '..\..\Source\AsyncIO.Detail.StreamBufferImpl.pas', 17 | AsyncIO.OpResults in '..\..\Source\AsyncIO.OpResults.pas', 18 | AsyncIO.Net.IP.Detail in '..\..\Source\AsyncIO.Net.IP.Detail.pas', 19 | AsyncIO.Net.IP.Detail.TCPImpl in '..\..\Source\AsyncIO.Net.IP.Detail.TCPImpl.pas', 20 | AsyncIO.Net.IP in '..\..\Source\AsyncIO.Net.IP.pas', 21 | AsyncIO in '..\..\Source\AsyncIO.pas', 22 | AsyncIO.StreamReader in '..\..\Source\AsyncIO.StreamReader.pas', 23 | AsyncHttpClient.Impl in 'AsyncHttpClient.Impl.pas'; 24 | 25 | procedure PrintUsage; 26 | begin 27 | WriteLn('Usage:'); 28 | WriteLn; 29 | WriteLn(' AsyncHttpClient url [filename]'); 30 | WriteLn; 31 | WriteLn(' url URL to retrieve'); 32 | WriteLn(' filename Filename where response is written,'); 33 | WriteLn(' default is response.dat'); 34 | WriteLn; 35 | end; 36 | 37 | procedure SaveDataToFile(const Data: TBytes; const Filename: string); 38 | var 39 | s: TBytesStream; 40 | begin 41 | s := nil; 42 | try 43 | s := TBytesStream.Create(Data); 44 | s.SaveToFile(Filename); 45 | finally 46 | s.Free; 47 | end; 48 | end; 49 | 50 | function IsBinaryData(const Data: TBytes): boolean; 51 | var 52 | i: NativeInt; 53 | begin 54 | result := False; 55 | for I := 0 to High(Data) do 56 | begin 57 | if (Data[i] = 0) then 58 | exit; 59 | end; 60 | result := True; 61 | end; 62 | 63 | procedure Run(const URL: string; const ResponseFilename: string); 64 | var 65 | ios: IOService; 66 | httpClient: AsyncHttpCli; 67 | responseHandler: HttpClientResponseHandler; 68 | r: Int64; 69 | begin 70 | responseHandler := 71 | procedure(const Headers: string; const ResponseData: TArray) 72 | var 73 | s: string; 74 | begin 75 | // rejoin split header lines 76 | s := Headers; 77 | s := StringReplace(s, #13#10#32, '', [rfReplaceAll]); 78 | s := StringReplace(s, #13#10#9, '', [rfReplaceAll]); 79 | 80 | WriteLn('HTTP response headers:'); 81 | WriteLn(s); 82 | 83 | SaveDataToFile(ResponseData, ResponseFilename); 84 | end; 85 | 86 | ios := NewIOService(); 87 | httpClient := NewAsyncHttpClient(ios, responseHandler); 88 | httpClient.ProgressHandler := 89 | procedure(const Status: string) 90 | begin 91 | WriteLn(Status); 92 | end; 93 | 94 | httpClient.Get(URL); 95 | 96 | r := ios.Run; 97 | 98 | WriteLn; 99 | WriteLn(Format('%d handlers executed', [r])); 100 | end; 101 | 102 | var 103 | url: string; 104 | filename: string; 105 | begin 106 | try 107 | if (ParamCount() < 1) then 108 | PrintUsage 109 | else 110 | begin 111 | url := ParamStr(1); 112 | 113 | filename := 'response.dat'; 114 | if (ParamCount() >= 2) then 115 | filename := ParamStr(2); 116 | 117 | Run(url, filename); 118 | end; 119 | except 120 | on E: Exception do 121 | Writeln(E.ClassName, ': ', E.Message); 122 | end; 123 | end. 124 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # AsyncIO 2 | 3 | Delphi.AsyncIO library, inspired by Boost.ASIO. 4 | 5 | Under development! Currently mostly for fun. 6 | 7 | Uses IOCP under the hood. 8 | 9 | ## TPC echo client example 10 | 11 | Library is under development, but this should show the direction. 12 | 13 | ```delphi 14 | type 15 | EchoClient = class 16 | private 17 | FRequest: string; 18 | FData: TBytes; 19 | FSocket: IPStreamSocket; 20 | FStream: AsyncSocketStream; 21 | 22 | procedure HandleConnect(const ErrorCode: IOErrorCode); 23 | procedure HandleWrite(const ErrorCode: IOErrorCode; const BytesTransferred: UInt64); 24 | procedure HandleRead(const ErrorCode: IOErrorCode; const BytesTransferred: UInt64); 25 | public 26 | constructor Create(const Service: IOService; 27 | const ServerEndpoint: IPEndpoint; 28 | const Request: string); 29 | end; 30 | 31 | procedure TestEcho; 32 | var 33 | qry: IPResolver.Query; 34 | res: IPResolver.Results; 35 | ip: IPResolver.Entry; 36 | ios: IOService; 37 | client: EchoClient; 38 | r: Int64; 39 | begin 40 | qry := Query(IPProtocol.TCP.v6, 'localhost', '7', [ResolveAllMatching]); 41 | res := IPResolver.Resolve(qry); 42 | 43 | ip := res[0]; // TODO - make connect take resolver result set, connect until success 44 | 45 | ios := nil; 46 | client := nil; 47 | try 48 | ios := NewIOService; 49 | 50 | WriteLn('Connecting to ' + ip.Endpoint); 51 | 52 | client := EchoClient.Create(ios, ip.Endpoint, 'Hello Internet!'); 53 | 54 | r := ios.Run; 55 | 56 | WriteLn; 57 | WriteLn('Done'); 58 | finally 59 | client.Free; 60 | end; 61 | end; 62 | 63 | { EchoClient } 64 | 65 | constructor EchoClient.Create( 66 | const Service: IOService; 67 | const ServerEndpoint: IPEndpoint; 68 | const Request: string); 69 | begin 70 | inherited Create; 71 | 72 | FRequest := Request; 73 | 74 | FSocket := NewTCPSocket(Service); 75 | 76 | FSocket.AsyncConnect(ServerEndpoint, HandleConnect); 77 | end; 78 | 79 | procedure EchoClient.HandleConnect(const ErrorCode: IOErrorCode); 80 | begin 81 | if (not ErrorCode) then 82 | RaiseLastOSError(ErrorCode.Value); 83 | 84 | WriteLn('Client connected'); 85 | WriteLn('Local endpoint: ' + FSocket.LocalEndpoint); 86 | WriteLn('Remote endpoint: ' + FSocket.RemoteEndpoint); 87 | WriteLn('Sending echo request'); 88 | 89 | // encode echo request 90 | FData := TEncoding.Unicode.GetBytes(FRequest); 91 | 92 | // use a socket stream for the actual read/write operations 93 | FStream := NewAsyncSocketStream(FSocket); 94 | 95 | AsyncWrite(FStream, FData, TransferAll(), HandleWrite); 96 | end; 97 | 98 | procedure EchoClient.HandleWrite(const ErrorCode: IOErrorCode; 99 | const BytesTransferred: UInt64); 100 | begin 101 | if (not ErrorCode) then 102 | RaiseLastOSError(ErrorCode.Value); 103 | 104 | // half close 105 | FSocket.Shutdown(SocketShutdownWrite); 106 | 107 | // zero our response buffer so we know we got the right stuff back 108 | FillChar(FData[0], Length(FData), 0); 109 | 110 | AsyncRead(FStream, FResponseData, TransferAtLeast(Length(FData)), HandleRead); 111 | end; 112 | 113 | procedure EchoClient.HandleRead(const ErrorCode: IOErrorCode; 114 | const BytesTransferred: UInt64); 115 | var 116 | s: string; 117 | responseMatches: boolean; 118 | begin 119 | if (not ErrorCode) then 120 | RaiseLastOSError(ErrorCode.Value); 121 | 122 | // decode echo response 123 | s := TEncoding.Unicode.GetString(FData, 0, BytesTransferred); 124 | 125 | WriteLn('Echo reply: "' + s + '"'); 126 | 127 | FSocket.Close(); 128 | 129 | // stopping to be improved 130 | FStream.Socket.Service.Stop; 131 | end; 132 | ``` 133 | 134 | Output from the above program: 135 | ``` 136 | Connecting to [::1]:7 137 | Client connected 138 | Local endpoint: [::1]:61659 139 | Remote endpoint: [::1]:7 140 | Sending echo request 141 | Echo reply: "Hello Internet!" 142 | 143 | Done 144 | ``` 145 | 146 | ## License 147 | 148 | Licensed under the Apache 2.0 license, see LICENSE file for details. -------------------------------------------------------------------------------- /Examples/HTTP/AsyncHttpServer.Headers.pas: -------------------------------------------------------------------------------- 1 | unit AsyncHttpServer.Headers; 2 | 3 | interface 4 | 5 | type 6 | HttpHeader = record 7 | Name: string; 8 | Value: string; 9 | end; 10 | 11 | // HttpHeaderRef = record 12 | // public 13 | // type HttpHeaderPtr = ^HttpHeader; 14 | // strict private 15 | // FHeader: HttpHeaderPtr; 16 | // 17 | // function GetName: string; 18 | // function GetValue: string; 19 | // 20 | // procedure SetName(const Value: string); 21 | // procedure SetValue(const Value: string); 22 | // public 23 | // class operator Implicit(const HeaderPtr: HttpHeaderPtr): HttpHeaderRef; 24 | // 25 | // property Name: string read GetName write SetName; 26 | // property Value: string read GetValue write SetValue; 27 | // end; 28 | 29 | HttpHeaders = TArray; 30 | 31 | HttpHeadersHelper = record helper for HttpHeaders 32 | {$REGION 'Property accessors'} 33 | function GetValue(const Name: string): string; 34 | procedure SetValue(const Name, Value: string); 35 | {$ENDREGION} 36 | 37 | // procedure Append; overload; 38 | procedure Append(const Header: HttpHeader); overload; 39 | 40 | function IsEmpty: boolean; 41 | 42 | // function Last: HttpHeaderRef; 43 | 44 | function ToDebugString: string; 45 | 46 | property Value[const Name: string]: string read GetValue write SetValue; 47 | end; 48 | 49 | function EmptyHttpHeader(): HttpHeader; 50 | 51 | implementation 52 | 53 | uses 54 | System.SysUtils; 55 | 56 | function EmptyHttpHeader(): HttpHeader; 57 | begin 58 | result.Name := ''; 59 | result.Value := ''; 60 | end; 61 | 62 | //{ HttpHeaderRef } 63 | // 64 | //function HttpHeaderRef.GetName: string; 65 | //begin 66 | // result := FHeader^.Name; 67 | //end; 68 | // 69 | //function HttpHeaderRef.GetValue: string; 70 | //begin 71 | // result := FHeader^.Value; 72 | //end; 73 | // 74 | //class operator HttpHeaderRef.Implicit( 75 | // const HeaderPtr: HttpHeaderPtr): HttpHeaderRef; 76 | //begin 77 | // result.FHeader := HeaderPtr; 78 | //end; 79 | // 80 | //procedure HttpHeaderRef.SetName(const Value: string); 81 | //begin 82 | // FHeader^.Name := Value; 83 | //end; 84 | // 85 | //procedure HttpHeaderRef.SetValue(const Value: string); 86 | //begin 87 | // FHeader^.Value := Value; 88 | //end; 89 | 90 | { HttpHeadersHelper } 91 | 92 | //procedure HttpHeadersHelper.Append; 93 | //var 94 | // header: HttpHeader; 95 | //begin 96 | // Self.Append(header); 97 | //end; 98 | 99 | procedure HttpHeadersHelper.Append(const Header: HttpHeader); 100 | begin 101 | if (Header.Name = '') then 102 | exit; 103 | 104 | Insert(Header, Self, Length(Self)); 105 | end; 106 | 107 | function HttpHeadersHelper.GetValue(const Name: string): string; 108 | var 109 | i: integer; 110 | begin 111 | result := ''; 112 | for i := 0 to High(Self) do 113 | begin 114 | if (Self[i].Name = Name) then 115 | begin 116 | result := Self[i].Value; 117 | exit; 118 | end; 119 | end; 120 | end; 121 | 122 | function HttpHeadersHelper.IsEmpty: boolean; 123 | begin 124 | result := (Length(Self) = 0); 125 | end; 126 | 127 | //function HttpHeadersHelper.Last: HttpHeaderRef; 128 | //begin 129 | // if (Self.IsEmpty) then 130 | // raise EInvalidOpException.Create('HttpHeaders.Last called on empty instance'); 131 | // 132 | // result := @Self[High(Self)]; 133 | //end; 134 | 135 | procedure HttpHeadersHelper.SetValue(const Name, Value: string); 136 | var 137 | i: integer; 138 | header: HttpHeader; 139 | begin 140 | for i := 0 to High(Self) do 141 | begin 142 | if (Self[i].Name = Name) then 143 | begin 144 | Self[i].Value := Value; 145 | exit; 146 | end; 147 | end; 148 | 149 | // append new header 150 | header.Name := Name; 151 | header.Value := Value; 152 | Self.Append(header); 153 | end; 154 | 155 | function HttpHeadersHelper.ToDebugString: string; 156 | var 157 | h: HttpHeader; 158 | begin 159 | result := ''; 160 | for h in Self do 161 | begin 162 | result := result + #13#10 + ' ' + h.Name + ': ' + h.Value; 163 | end; 164 | end; 165 | 166 | end. 167 | -------------------------------------------------------------------------------- /AsyncIO.groupproj: -------------------------------------------------------------------------------- 1 | 2 | 3 | {8660C5AD-C8D9-499D-B588-FC0D7B64BABA} 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | Default.Personality.12 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57 | 58 | 59 | 60 | 61 | 62 | 63 | 64 | 65 | 66 | 67 | 68 | 69 | 70 | 71 | 72 | 73 | 74 | 75 | 76 | 77 | 78 | 79 | 80 | 81 | 82 | 83 | 84 | 85 | 86 | 87 | 88 | 89 | 90 | 91 | 92 | 93 | 94 | 95 | 96 | 97 | -------------------------------------------------------------------------------- /Test/IPStreamSocketMock.pas: -------------------------------------------------------------------------------- 1 | unit IPStreamSocketMock; 2 | 3 | interface 4 | 5 | uses 6 | IdWinsock2, AsyncIO, AsyncIO.Net.IP; 7 | 8 | type 9 | TIPStreamSocketMock = class(TInterfacedObject, IPStreamSocket) 10 | strict private 11 | FConnected: boolean; 12 | FLocalEndpoint: IPEndpoint; 13 | FPeerEndpoint: IPEndpoint; 14 | FService: IOService; 15 | public 16 | constructor Create(const Service: IOService); 17 | 18 | function GetService: IOService; 19 | function GetProtocol: IPProtocol; 20 | function GetLocalEndpoint: IPEndpoint; 21 | function GetRemoteEndpoint: IPEndpoint; 22 | function GetSocketHandle: TSocket; 23 | 24 | procedure AsyncConnect(const PeerEndpoint: IPEndpoint; const Handler: OpHandler); 25 | 26 | procedure Bind(const LocalEndpoint: IPEndpoint); 27 | 28 | procedure Connect(const PeerEndpoint: IPEndpoint); 29 | procedure Close; 30 | 31 | procedure Shutdown(const ShutdownFlag: SocketShutdownFlag = SocketShutdownBoth); overload; 32 | 33 | procedure AsyncSend(const Buffer: MemoryBuffer; const Handler: IOHandler); overload; 34 | procedure AsyncReceive(const Buffer: MemoryBuffer; const Handler: IOHandler); overload; 35 | end; 36 | 37 | implementation 38 | 39 | uses 40 | System.SysUtils, AsyncIO.OpResults; 41 | 42 | { TIPStreamSocketMock } 43 | 44 | procedure TIPStreamSocketMock.AsyncConnect(const PeerEndpoint: IPEndpoint; const Handler: OpHandler); 45 | var 46 | peer: IPEndpoint; 47 | begin 48 | peer := PeerEndpoint; 49 | FService.Post( 50 | procedure 51 | begin 52 | if (FConnected) then 53 | begin 54 | Handler(NetResults.IsConnected) 55 | end 56 | else 57 | begin 58 | FPeerEndpoint := peer; 59 | FConnected := True; 60 | Handler(NetResults.Success); 61 | end; 62 | end 63 | ); 64 | end; 65 | 66 | procedure TIPStreamSocketMock.AsyncReceive(const Buffer: MemoryBuffer; const Handler: IOHandler); 67 | var 68 | bufferSize: UInt64; 69 | begin 70 | bufferSize := Buffer.Size; 71 | FService.Post( 72 | procedure 73 | begin 74 | if (FConnected) then 75 | Handler(NetResults.Success, bufferSize) 76 | else 77 | Handler(NetResults.NotConnected, 0); 78 | end 79 | ); 80 | end; 81 | 82 | procedure TIPStreamSocketMock.AsyncSend(const Buffer: MemoryBuffer; const Handler: IOHandler); 83 | var 84 | bufferSize: UInt64; 85 | begin 86 | bufferSize := Buffer.Size; 87 | FService.Post( 88 | procedure 89 | begin 90 | if (FConnected) then 91 | Handler(NetResults.Success, bufferSize) 92 | else 93 | Handler(NetResults.NotConnected, 0); 94 | end 95 | ); 96 | end; 97 | 98 | procedure TIPStreamSocketMock.Bind(const LocalEndpoint: IPEndpoint); 99 | begin 100 | FLocalEndpoint := LocalEndpoint; 101 | end; 102 | 103 | procedure TIPStreamSocketMock.Close; 104 | begin 105 | raise ENotImplemented.Create('TIPStreamSocketMock.Close'); 106 | end; 107 | 108 | procedure TIPStreamSocketMock.Connect(const PeerEndpoint: IPEndpoint); 109 | begin 110 | if (FConnected) then 111 | NetResults.IsConnected.RaiseException; 112 | 113 | FPeerEndpoint := PeerEndpoint; 114 | FConnected := True; 115 | end; 116 | 117 | constructor TIPStreamSocketMock.Create(const Service: IOService); 118 | begin 119 | inherited Create; 120 | 121 | FService := Service; 122 | FLocalEndpoint := Endpoint(); 123 | FPeerEndpoint := Endpoint(); 124 | end; 125 | 126 | function TIPStreamSocketMock.GetLocalEndpoint: IPEndpoint; 127 | begin 128 | result := FLocalEndpoint; 129 | end; 130 | 131 | function TIPStreamSocketMock.GetProtocol: IPProtocol; 132 | begin 133 | raise ENotImplemented.Create('TIPStreamSocketMock.GetProtocol'); 134 | end; 135 | 136 | function TIPStreamSocketMock.GetRemoteEndpoint: IPEndpoint; 137 | begin 138 | result := FPeerEndpoint; 139 | end; 140 | 141 | function TIPStreamSocketMock.GetService: IOService; 142 | begin 143 | result := FService; 144 | end; 145 | 146 | function TIPStreamSocketMock.GetSocketHandle: TSocket; 147 | begin 148 | raise ENotImplemented.Create('TIPStreamSocketMock.GetSocketHandle'); 149 | end; 150 | 151 | procedure TIPStreamSocketMock.Shutdown(const ShutdownFlag: SocketShutdownFlag); 152 | begin 153 | raise ENotImplemented.Create('TIPStreamSocketMock.Shutdown'); 154 | end; 155 | 156 | end. 157 | -------------------------------------------------------------------------------- /dev/AsyncIO.Test.Copy.pas: -------------------------------------------------------------------------------- 1 | unit AsyncIO.Test.Copy; 2 | 3 | interface 4 | 5 | procedure RunCopyTest; 6 | 7 | implementation 8 | 9 | uses 10 | System.SysUtils, System.DateUtils, AsyncIO, AsyncIO.ErrorCodes, System.Math, 11 | AsyncIO.Filesystem; 12 | 13 | type 14 | FileCopier = class 15 | private 16 | FBuffer: TBytes; 17 | FInputStream: AsyncFileStream; 18 | FOutputStream: AsyncFileStream; 19 | FTotalBytesRead: UInt64; 20 | FTotalBytesWritten: UInt64; 21 | FReadTimestamp: TDateTime; 22 | FWriteTimestamp: TDateTime; 23 | FReadTimeMSec: Int64; 24 | FWriteTimeMSec: Int64; 25 | FPrintTimestamp: TDateTime; 26 | FDoneReading: boolean; 27 | 28 | procedure ReadHandler(const ErrorCode: IOErrorCode; const BytesTransferred: UInt64); 29 | procedure WriteHandler(const ErrorCode: IOErrorCode; const BytesTransferred: UInt64); 30 | procedure PrintProgress; 31 | public 32 | constructor Create(const Service: IOService; const InputFilename, OutputFilename: string); 33 | end; 34 | 35 | procedure RunCopyTest; 36 | var 37 | inputFilename, outputFilename: string; 38 | ios: IOService; 39 | copier: FileCopier; 40 | r: Int64; 41 | begin 42 | ios := nil; 43 | copier := nil; 44 | try 45 | ios := NewIOService(); 46 | 47 | inputFilename := ParamStr(1); 48 | outputFilename := ParamStr(2); 49 | 50 | if (inputFilename = '') or (outputFilename = '') then 51 | raise Exception.Create('Missing command line parameters'); 52 | 53 | copier := FileCopier.Create(ios, inputFilename, outputFilename); 54 | 55 | r := ios.Poll; 56 | 57 | WriteLn; 58 | WriteLn(Format('%d handlers executed', [r])); 59 | 60 | finally 61 | copier.Free; 62 | end; 63 | end; 64 | 65 | { FileCopier } 66 | 67 | constructor FileCopier.Create(const Service: IOService; const InputFilename, 68 | OutputFilename: string); 69 | begin 70 | inherited Create; 71 | 72 | SetLength(FBuffer, 1024*1024); 73 | FInputStream := NewAsyncFileStream(Service, InputFilename, fcOpenExisting, faRead, fsRead); 74 | FOutputStream := NewAsyncFileStream(Service, OutputFilename, fcCreateAlways, faWrite, fsNone); 75 | FDoneReading := False; 76 | 77 | Service.Post( 78 | procedure 79 | begin 80 | // queue read to start things 81 | FReadTimestamp := Now; 82 | AsyncRead(FInputStream, FBuffer, TransferAll(), ReadHandler); 83 | end 84 | ); 85 | end; 86 | 87 | procedure FileCopier.PrintProgress; 88 | begin 89 | if (MilliSecondsBetween(Now, FPrintTimestamp) < 500) then 90 | exit; 91 | 92 | Write(Format(#13'Read: %3d MB (%.2f MB/s) | Written: %3d MB (%.2f MB/s) ', 93 | [FTotalBytesRead shr 20, FTotalBytesRead / (1e3 * Max(1, FReadTimeMSec)), 94 | FTotalBytesWritten shr 20, FTotalBytesWritten / (1e3 * Max(1, FWriteTimeMSec))])); 95 | FPrintTimestamp := Now; 96 | end; 97 | 98 | procedure FileCopier.ReadHandler(const ErrorCode: IOErrorCode; 99 | const BytesTransferred: UInt64); 100 | begin 101 | if (ErrorCode) and (ErrorCode <> IOErrorCode.EndOfFile) then 102 | begin 103 | RaiseLastOSError(ErrorCode.Value, 'While reading file'); 104 | end; 105 | 106 | if (ErrorCode = IOErrorCode.EndOfFile) then 107 | FDoneReading := True; 108 | 109 | FTotalBytesRead := FTotalBytesRead + BytesTransferred; 110 | FReadTimeMSec := FReadTimeMSec + MilliSecondsBetween(Now, FReadTimestamp); 111 | PrintProgress; 112 | 113 | if (BytesTransferred = 0) then 114 | exit; 115 | 116 | // reading done, queue write 117 | FWriteTimestamp := Now; 118 | AsyncWrite(FOutputStream, FBuffer, TransferExactly(BytesTransferred), WriteHandler); 119 | end; 120 | 121 | procedure FileCopier.WriteHandler(const ErrorCode: IOErrorCode; 122 | const BytesTransferred: UInt64); 123 | begin 124 | if (ErrorCode) then 125 | begin 126 | RaiseLastOSError(ErrorCode.Value, 'While writing file'); 127 | end; 128 | 129 | if (FDoneReading) then 130 | FPrintTimestamp := 0; 131 | 132 | FTotalBytesWritten := FTotalBytesWritten + BytesTransferred; 133 | FWriteTimeMSec := FWriteTimeMSec + MilliSecondsBetween(Now, FWriteTimestamp); 134 | PrintProgress; 135 | 136 | if (FDoneReading) then 137 | exit; 138 | 139 | // writing done and we got more to read, so queue read 140 | FReadTimestamp := Now; 141 | AsyncRead(FInputStream, FBuffer, TransferAll(), ReadHandler); 142 | end; 143 | 144 | end. 145 | -------------------------------------------------------------------------------- /Examples/HTTP/HttpDateTime.pas: -------------------------------------------------------------------------------- 1 | unit HttpDateTime; 2 | 3 | interface 4 | 5 | uses 6 | WinAPI.Windows, System.SysUtils; 7 | 8 | function SystemTimeToHttpDate(const st: TSystemTime): string; 9 | function TryHttpDateToSystemTime(const HttpDate: string; out st: TSystemTime): boolean; 10 | 11 | function CurrentSystemTime: TSystemTime; 12 | function CompareSystemTime(const A, B: TSystemTime): integer; 13 | 14 | implementation 15 | 16 | uses 17 | System.Types; 18 | 19 | const 20 | WeekdayNames: array[0..6] of string = ( 21 | 'Sun', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat', 'Mon' 22 | ); 23 | MonthNames: array[1..12] of string = ( 24 | 'Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun', 'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec' 25 | ); 26 | 27 | function SystemTimeToHttpDate(const st: TSystemTime): string; 28 | begin 29 | if ((st.wDayOfWeek > 6) or (st.wMonth < 1) or (st.wMonth > 12)) then 30 | raise EConvertError.Create('SystemTimeToHTTPDate: Invalid date'); 31 | 32 | result := Format('%s, %.2d %s %.4d %.2d:%.2d:%.2d GMT', 33 | [WeekdayNames[st.wDayOfWeek], st.wDay, MonthNames[st.wMonth], st.wYear, st.wHour, st.wMinute, st.wSecond] 34 | ); 35 | end; 36 | 37 | function TryHttpDateToSystemTime(const HttpDate: string; out st: TSystemTime): boolean; 38 | var 39 | dateElm: TArray; 40 | i, ybase: integer; 41 | foundWeekday: boolean; 42 | foundMonth: boolean; 43 | begin 44 | result := False; 45 | 46 | // transform both date formats to similar form 47 | dateElm := HttpDate.Replace('-', ' ').Replace(':', ' ').Split([' ']); 48 | 49 | if (Length(dateElm) <> 8) then 50 | exit; 51 | 52 | 53 | // weekday 54 | for i := Low(WeekdayNames) to High(WeekdayNames) do 55 | begin 56 | foundWeekday := dateElm[0].StartsWith(WeekdayNames[i]); 57 | if (foundWeekday) then 58 | begin 59 | st.wDayOfWeek := i; 60 | break; 61 | end; 62 | end; 63 | 64 | if (not foundWeekday) then 65 | exit; 66 | 67 | 68 | // day 69 | i := StrToIntDef(dateElm[1], -1); 70 | if ((i < 1) or (i > 31)) then 71 | exit; 72 | 73 | st.wDay := i; 74 | 75 | 76 | // month 77 | for i := Low(MonthNames) to High(MonthNames) do 78 | begin 79 | foundMonth := dateElm[2].StartsWith(MonthNames[i]); 80 | if (foundMonth) then 81 | begin 82 | st.wMonth := i; 83 | break; 84 | end; 85 | end; 86 | 87 | if (not foundMonth) then 88 | exit; 89 | 90 | 91 | // year 92 | i := StrToIntDef(dateElm[3], -1); 93 | if ((i < 1) or (i > 9999)) then 94 | exit; 95 | 96 | if (i < 100) then 97 | begin 98 | // hardcoded century window because that's what people who use 2-digit years get 99 | ybase := CurrentYear() - 50; 100 | i := i + ((ybase div 100) * 100); 101 | if (i < ybase) then 102 | i := i + 100; 103 | end; 104 | 105 | st.wYear := i; 106 | 107 | 108 | // hour 109 | i := StrToIntDef(dateElm[4], -1); 110 | if ((i < 0) or (i > 23)) then 111 | exit; 112 | 113 | st.wHour := i; 114 | 115 | 116 | // minute 117 | i := StrToIntDef(dateElm[5], -1); 118 | if ((i < 0) or (i > 59)) then 119 | exit; 120 | 121 | st.wMinute := i; 122 | 123 | 124 | // second 125 | i := StrToIntDef(dateElm[6], -1); 126 | if ((i < 0) or (i > 60)) then // accept leap seconds? 127 | exit; 128 | 129 | st.wSecond := i; 130 | 131 | 132 | // timezone required to be GMT per HTTP 133 | if (dateElm[7] <> 'GMT') then 134 | exit; 135 | 136 | result := True; 137 | end; 138 | 139 | function CompareSystemTime(const A, B: TSystemTime): integer; 140 | var 141 | dateA, dateB: integer; 142 | timeA, timeB: integer; 143 | begin 144 | dateA := (A.wYear * 10000) + (A.wMonth * 100) + A.wDay; 145 | dateB := (B.wYear * 10000) + (B.wMonth * 100) + B.wDay; 146 | 147 | timeA := (A.wHour * 10000) + (A.wMinute * 100) + A.wSecond; 148 | timeB := (B.wHour * 10000) + (B.wMinute * 100) + B.wSecond; 149 | 150 | if (dateA < dateB) then 151 | begin 152 | result := LessThanValue; 153 | end 154 | else if (dateA > dateB) then 155 | begin 156 | result := GreaterThanValue; 157 | end 158 | else if (timeA < timeB) then 159 | begin 160 | result := LessThanValue; 161 | end 162 | else if (timeA > timeB) then 163 | begin 164 | result := GreaterThanValue; 165 | end 166 | else 167 | begin 168 | result := EqualsValue; 169 | end; 170 | end; 171 | 172 | function CurrentSystemTime: TSystemTime; 173 | begin 174 | GetSystemTime(result); 175 | end; 176 | 177 | end. 178 | -------------------------------------------------------------------------------- /Examples/HTTP/AsyncHttpServer.Impl.pas: -------------------------------------------------------------------------------- 1 | unit AsyncHttpServer.Impl; 2 | 3 | interface 4 | 5 | uses 6 | System.SysUtils, AsyncIO, AsyncIO.Net.IP, AsyncHttpServer.Mime; 7 | 8 | type 9 | AsyncHttpSrv = interface 10 | ['{B42FCD26-7EC9-449D-B2B1-7A8BC24AA541}'] 11 | {$REGION 'Property accessors'} 12 | function GetService: IOService; 13 | {$ENDREGION} 14 | 15 | procedure Run; 16 | 17 | property Service: IOService read GetService; 18 | end; 19 | 20 | function NewAsyncHttpSrv(const LocalAddress: string; const Port: integer; const DocRoot: string; const Mime: MimeRegistry): AsyncHttpSrv; 21 | 22 | implementation 23 | 24 | uses 25 | AsyncIO.OpResults, AsyncHttpServer.Connection, 26 | AsyncHttpServer.RequestHandler; 27 | 28 | type 29 | AsyncHttpSrvImpl = class(TInterfacedObject, AsyncHttpSrv) 30 | strict private 31 | FService: IOService; 32 | FEndpoint: IPEndpoint; 33 | FDocRoot: string; 34 | FMime: MimeRegistry; 35 | FAcceptor: IPAcceptor; 36 | FSocket: IPStreamSocket; 37 | FConnectionManager: HttpConnectionManager; 38 | FRequestHandler: HttpRequestHandler; 39 | 40 | procedure Log(const Msg: string); 41 | 42 | procedure DoAccept; 43 | 44 | procedure AcceptHandler(const Res: OpResult); 45 | public 46 | constructor Create(const Service: IOService; const Endpoint: IPEndpoint; const DocRoot: string; const Mime: MimeRegistry); 47 | 48 | function GetService: IOService; 49 | 50 | procedure Run; 51 | 52 | property Service: IOService read FService; 53 | property DocRoot: string read FDocRoot; 54 | property Mime: MimeRegistry read FMime; 55 | property RequestHandler: HttpRequestHandler read FRequestHandler; 56 | property ConnectionManager: HttpConnectionManager read FConnectionManager; 57 | end; 58 | 59 | function NewAsyncHttpSrv(const LocalAddress: string; const Port: integer; const DocRoot: string; const Mime: MimeRegistry): AsyncHttpSrv; 60 | var 61 | service: IOService; 62 | qry: IPResolver.Query; 63 | res: IPResolver.Results; 64 | endpoints: TArray; 65 | begin 66 | service := NewIOService(); 67 | 68 | qry := Query(IPProtocol.TCP.Unspecified, LocalAddress, IntToStr(Port)); 69 | 70 | // TODO - implement async resolve 71 | res := IPResolver.Resolve(qry); 72 | 73 | endpoints := res.GetEndpoints(); 74 | 75 | if (Length(endpoints) <= 0) then 76 | raise EArgumentException.Create('Invalid listening address'); 77 | 78 | result := AsyncHttpSrvImpl.Create(service, endpoints[0], DocRoot, Mime); 79 | end; 80 | 81 | { AsyncHttpSrvImpl } 82 | 83 | procedure AsyncHttpSrvImpl.AcceptHandler(const Res: OpResult); 84 | var 85 | connection: HttpConnection; 86 | begin 87 | // check if it's time to go 88 | if (not FAcceptor.IsOpen) then 89 | exit; 90 | 91 | if (Res.Success) then 92 | begin 93 | {$IFDEF DEBUG_LOG} 94 | Log('Accepted connection from ' + FSocket.RemoteEndpoint); 95 | {$ENDIF} 96 | 97 | connection := NewHttpConnection(FSocket, ConnectionManager, RequestHandler); 98 | connection.Start; 99 | FSocket := nil; 100 | end; 101 | 102 | DoAccept; 103 | end; 104 | 105 | constructor AsyncHttpSrvImpl.Create(const Service: IOService; 106 | const Endpoint: IPEndpoint; const DocRoot: string; const Mime: MimeRegistry); 107 | begin 108 | inherited Create; 109 | 110 | FService := Service; 111 | FEndpoint := Endpoint; 112 | FDocRoot := DocRoot; 113 | FMime := Mime; 114 | FConnectionManager := NewHttpConnectionManager(); 115 | FRequestHandler := NewHttpRequestHandler(Service, DocRoot, Mime); 116 | end; 117 | 118 | procedure AsyncHttpSrvImpl.DoAccept; 119 | begin 120 | FSocket := NewTCPSocket(Service); 121 | FAcceptor.AsyncAccept(FSocket, AcceptHandler); 122 | end; 123 | 124 | function AsyncHttpSrvImpl.GetService: IOService; 125 | begin 126 | result := FService; 127 | end; 128 | 129 | procedure AsyncHttpSrvImpl.Log(const Msg: string); 130 | begin 131 | WriteLn('[' + FormatDateTime('yyyy.mm.dd hh:nn:ss.zzz', Now()) + '] ' + Msg); 132 | end; 133 | 134 | procedure AsyncHttpSrvImpl.Run; 135 | begin 136 | if (Assigned(FAcceptor)) then 137 | raise EInvalidOpException.Create('Run called on running AsyncHttpSrv'); 138 | 139 | FAcceptor := NewTCPAcceptor(Service); 140 | FAcceptor.Open(FEndpoint.Protocol); 141 | // TODO - set SO_REUSEADDR socket option 142 | FAcceptor.Bind(FEndpoint); 143 | FAcceptor.Listen; 144 | 145 | DoAccept; 146 | 147 | // run returns when all connections are done 148 | // and acceptor has stopped listening 149 | Service.Run; 150 | 151 | FAcceptor := nil; 152 | end; 153 | 154 | end. 155 | -------------------------------------------------------------------------------- /Examples/HTTP/AsyncHttpServer.Response.pas: -------------------------------------------------------------------------------- 1 | unit AsyncHttpServer.Response; 2 | 3 | interface 4 | 5 | uses 6 | System.SysUtils, AsyncIO, AsyncHttpServer.Headers; 7 | 8 | type 9 | HttpStatus = ( 10 | StatusNoStatus = 0, 11 | StatusOK = 200, 12 | StatusCreated = 201, 13 | StatusAccepted = 202, 14 | StatusNoContent = 204, 15 | StatusMultipleChoices = 300, 16 | StatusMovedPermanently = 301, 17 | StatusMovedTemporarily = 302, 18 | StatusNotModified = 304, 19 | StatusBadRequest = 400, 20 | StatusUnauthorized = 401, 21 | StatusForbidden = 403, 22 | StatusNotFound = 404, 23 | StatusInternalServerError = 500, 24 | StatusNotImplemented = 501, 25 | StatusBadGateway = 502, 26 | StatusServiceUnavailable = 503 27 | ); 28 | 29 | HttpStatusHelper = record helper for HttpStatus 30 | function ToString(): string; 31 | end; 32 | 33 | HttpResponse = record 34 | Status: HttpStatus; 35 | Headers: HttpHeaders; 36 | Content: TBytes; 37 | ContentStream: AsyncStream; 38 | 39 | // get a StreamBuffer containing the response, including Content 40 | // ContentStream needs to be handled separately if assigned 41 | // TODO - use array of MemoryBuffer once that's supported 42 | function ToBuffer(): StreamBuffer; 43 | end; 44 | 45 | function StandardResponse(const Status: HttpStatus): HttpResponse; 46 | 47 | implementation 48 | 49 | uses 50 | System.Classes, Generics.Collections; 51 | 52 | type 53 | TStreamHelper = class helper for TStream 54 | procedure WriteASCIIData(const s: string); 55 | end; 56 | 57 | { TStreamHelper } 58 | 59 | procedure TStreamHelper.WriteASCIIData(const s: string); 60 | var 61 | b: TBytes; 62 | begin 63 | b := TEncoding.ASCII.GetBytes(s); 64 | Self.WriteBuffer(b, Length(b)); 65 | end; 66 | 67 | { HttpStatusHelper } 68 | 69 | function HttpStatusHelper.ToString: string; 70 | begin 71 | case Self of 72 | StatusOK: 73 | result := 'OK'; 74 | StatusCreated: 75 | result := 'Created'; 76 | StatusAccepted: 77 | result := 'Accepted'; 78 | StatusNoContent: 79 | result := 'No Content'; 80 | StatusMultipleChoices: 81 | result := 'Multiple Choices'; 82 | StatusMovedPermanently: 83 | result := 'Moved Permanently'; 84 | StatusMovedTemporarily: 85 | result := 'Moved Temporarily'; 86 | StatusNotModified: 87 | result := 'Not Modified'; 88 | StatusBadRequest: 89 | result := 'Bad Request'; 90 | StatusUnauthorized: 91 | result := 'Unauthorized'; 92 | StatusForbidden: 93 | result := 'Forbidden'; 94 | StatusNotFound: 95 | result := 'Not Found'; 96 | StatusInternalServerError: 97 | result := 'Internal ServerError'; 98 | StatusNotImplemented: 99 | result := 'Not Implemented'; 100 | StatusBadGateway: 101 | result := 'Bad Gateway'; 102 | StatusServiceUnavailable: 103 | result := 'Service Unavailable'; 104 | else 105 | raise EArgumentException.Create('Invalid HTTP status'); 106 | end; 107 | end; 108 | 109 | function StandardResponse(const Status: HttpStatus): HttpResponse; 110 | var 111 | s: string; 112 | begin 113 | if (Status = StatusNotModified) then 114 | begin 115 | // no entity body for this one 116 | result.Status := Status; 117 | result.Content := nil; 118 | result.ContentStream := nil; 119 | result.Headers := nil; 120 | end 121 | else 122 | begin 123 | s := Status.ToString; 124 | s := 125 | '' + 126 | '' + s + '' + 127 | '

' + IntToStr(Ord(Status)) + ' ' + s + '

' + 128 | ''; 129 | 130 | result.Status := Status; 131 | result.Content := TEncoding.ASCII.GetBytes(s); 132 | result.ContentStream := nil; 133 | result.Headers := nil; 134 | result.Headers.Value['Content-Length'] := IntToStr(Length(result.Content)); 135 | result.Headers.Value['Content-Type'] := 'text/html'; 136 | end; 137 | end; 138 | 139 | { HttpResponse } 140 | 141 | function HttpResponse.ToBuffer: StreamBuffer; 142 | var 143 | i: integer; 144 | begin 145 | // so currently this is very sub-optimal 146 | // however without scattered buffer support it's the best we can do 147 | result := StreamBuffer.Create(); 148 | 149 | result.Stream.WriteASCIIData('HTTP/1.0 ' + IntToStr(Ord(Status)) + ' ' + Status.ToString + #13#10); 150 | 151 | for i := 0 to High(Headers) do 152 | begin 153 | result.Stream.WriteASCIIData(Headers[i].Name); 154 | result.Stream.WriteASCIIData(': '); 155 | result.Stream.WriteASCIIData(Headers[i].Value); 156 | result.Stream.WriteASCIIData(#13#10); // CRLF 157 | end; 158 | 159 | result.Stream.WriteASCIIData(#13#10); // CRLF 160 | 161 | if (Length(Content) > 0) then 162 | begin 163 | result.Stream.WriteBuffer(Content, Length(Content)); 164 | end; 165 | end; 166 | 167 | end. 168 | -------------------------------------------------------------------------------- /Examples/FileCopy/AsyncFileCopy.Impl.pas: -------------------------------------------------------------------------------- 1 | unit AsyncFileCopy.Impl; 2 | 3 | interface 4 | 5 | uses 6 | System.SysUtils, System.DateUtils, AsyncIO, AsyncIO.OpResults, System.Math, 7 | AsyncIO.Filesystem; 8 | 9 | type 10 | IOProgressHandler = reference to procedure(const TotalBytesRead, TotalBytesWritten: UInt64; 11 | const ReadBPS, WriteBPS: double); 12 | 13 | AsyncFileCopier = interface 14 | {$REGION Property accessors} 15 | function GetService: IOService; 16 | {$ENDREGION} 17 | 18 | procedure Execute(const InputFilename, OutputFilename: string); 19 | 20 | property Service: IOService read GetService; 21 | end; 22 | 23 | function NewAsyncFileCopier(const Service: IOService; const ProgressHandler: IOProgressHandler; const BufferSize: integer = 4*1024): AsyncFileCopier; 24 | 25 | implementation 26 | 27 | uses 28 | AsyncIO.Coroutine; 29 | 30 | type 31 | AsyncFileCopierImpl = class(TInterfacedObject, AsyncFileCopier) 32 | private 33 | FService: IOService; 34 | FProgressHandler: IOProgressHandler; 35 | FBuffer: TBytes; 36 | FTotalBytesRead: UInt64; 37 | FTotalBytesWritten: UInt64; 38 | FReadTimeMSec: Int64; 39 | FWriteTimeMSec: Int64; 40 | FProgressTimestamp: TDateTime; 41 | 42 | procedure ProgressUpdate; 43 | public 44 | constructor Create(const Service: IOService; const ProgressHandler: IOProgressHandler; const BufferSize: integer); 45 | 46 | function GetService: IOService; 47 | 48 | procedure Execute(const InputFilename, OutputFilename: string); 49 | 50 | property Service: IOService read FService; 51 | end; 52 | 53 | function NewAsyncFileCopier(const Service: IOService; const ProgressHandler: IOProgressHandler; const BufferSize: integer): AsyncFileCopier; 54 | begin 55 | result := AsyncFileCopierImpl.Create(Service, ProgressHandler, BufferSize); 56 | end; 57 | 58 | { AsyncFileCopierImpl } 59 | 60 | constructor AsyncFileCopierImpl.Create(const Service: IOService; const ProgressHandler: IOProgressHandler; const BufferSize: integer); 61 | begin 62 | inherited Create; 63 | 64 | FService := Service; 65 | FProgressHandler := ProgressHandler; 66 | 67 | SetLength(FBuffer, BufferSize); 68 | end; 69 | 70 | procedure AsyncFileCopierImpl.Execute(const InputFilename, OutputFilename: string); 71 | var 72 | inputStream: AsyncFileStream; 73 | outputStream: AsyncFileStream; 74 | serviceContext: IOServiceCoroutineContext; 75 | yield: YieldContext; 76 | readRes: IOResult; 77 | writeRes: IOResult; 78 | doneReading: boolean; 79 | readTimestamp: TDateTime; 80 | writeTimestamp: TDateTime; 81 | begin 82 | inputStream := NewAsyncFileStream(Service, InputFilename, fcOpenExisting, faRead, fsRead); 83 | outputStream := NewAsyncFileStream(Service, OutputFilename, fcCreateAlways, faWrite, fsNone); 84 | 85 | serviceContext := NewIOServiceCoroutineContext(Service); 86 | yield := NewYieldContext(serviceContext); 87 | 88 | doneReading := False; 89 | 90 | while (True) do 91 | begin 92 | // queue the async read 93 | // this will return once the read has completed 94 | readTimestamp := Now; 95 | readRes := AsyncRead(inputStream, FBuffer, TransferAll(), yield); 96 | 97 | if (not readRes.Success) and (readRes <> SystemResults.EndOfFile) then 98 | begin 99 | readRes.RaiseException('Reading file'); 100 | end; 101 | 102 | // check for EOF 103 | if (readRes = SystemResults.EndOfFile) then 104 | doneReading := True; 105 | 106 | FTotalBytesRead := FTotalBytesRead + readRes.BytesTransferred; 107 | FReadTimeMSec := FReadTimeMSec + MilliSecondsBetween(Now, readTimestamp); 108 | 109 | ProgressUpdate; 110 | 111 | if (readRes.BytesTransferred = 0) then 112 | begin 113 | // stopping to be improved 114 | Service.Stop; 115 | exit; 116 | end; 117 | 118 | // we've read some data, now queue write 119 | // again this will return once the write has completed 120 | writeTimestamp := Now; 121 | writeRes := AsyncWrite(outputStream, FBuffer, TransferExactly(readRes.BytesTransferred), yield); 122 | 123 | if (not writeRes.Success) then 124 | begin 125 | writeRes.RaiseException('Writing file'); 126 | end; 127 | 128 | if (doneReading) then 129 | FProgressTimestamp := 0; 130 | 131 | FTotalBytesWritten := FTotalBytesWritten + writeRes.BytesTransferred; 132 | FWriteTimeMSec := FWriteTimeMSec + MilliSecondsBetween(Now, writeTimestamp); 133 | 134 | ProgressUpdate; 135 | 136 | if (doneReading) then 137 | begin 138 | // stopping to be improved 139 | Service.Stop; 140 | exit; 141 | end 142 | 143 | // writing done and we got more to read, so rinse repeat 144 | end; 145 | end; 146 | 147 | function AsyncFileCopierImpl.GetService: IOService; 148 | begin 149 | result := FService; 150 | end; 151 | 152 | procedure AsyncFileCopierImpl.ProgressUpdate; 153 | var 154 | readBPS, writeBPS: double; 155 | begin 156 | if (not Assigned(FProgressHandler)) then 157 | exit; 158 | 159 | if (MilliSecondsBetween(Now, FProgressTimestamp) < 500) then 160 | exit; 161 | 162 | readBPS := FTotalBytesRead / (1e3 * Max(1, FReadTimeMSec)); 163 | writeBPS := FTotalBytesWritten / (1e3 * Max(1, FWriteTimeMSec)); 164 | 165 | FProgressHandler(FTotalBytesRead, FTotalBytesWritten, readBPS, writeBPS); 166 | 167 | FProgressTimestamp := Now; 168 | end; 169 | 170 | end. 171 | -------------------------------------------------------------------------------- /Examples/TCPEcho/AsyncEchoClient.Impl.pas: -------------------------------------------------------------------------------- 1 | unit AsyncEchoClient.Impl; 2 | 3 | interface 4 | 5 | uses 6 | System.SysUtils, AsyncIO, AsyncIO.ErrorCodes, AsyncIO.Net.IP; 7 | 8 | type 9 | EchoClientProgressHandler = reference to procedure(const Status: string); 10 | 11 | AsyncTCPEchoClient = interface 12 | {$REGION Property accessors} 13 | function GetService: IOService; 14 | {$ENDREGION} 15 | 16 | procedure Execute(const Data: TBytes; const Host: string; const Port: integer = 7); 17 | 18 | property Service: IOService read GetService; 19 | end; 20 | 21 | function NewAsyncTCPEchoClient(const Service: IOService; const ProgressHandler: EchoClientProgressHandler): AsyncTCPEchoClient; 22 | 23 | implementation 24 | 25 | uses 26 | System.Math; 27 | 28 | type 29 | AsyncTCPEchoClientImpl = class(TInterfacedObject, AsyncTCPEchoClient) 30 | private 31 | FService: IOService; 32 | FProgressHandler: EchoClientProgressHandler; 33 | FData: TBytes; 34 | FResponseData: TBytes; 35 | FSocket: IPStreamSocket; 36 | FStream: AsyncSocketStream; 37 | 38 | function ConnectCondition(const ErrorCode: IOErrorCode; const Endpoint: IPEndpoint): boolean; 39 | procedure ConnectHandler(const ErrorCode: IOErrorCode; const Endpoint: IPEndpoint); 40 | procedure ReadHandler(const ErrorCode: IOErrorCode; const BytesTransferred: UInt64); 41 | procedure WriteHandler(const ErrorCode: IOErrorCode; const BytesTransferred: UInt64); 42 | 43 | procedure ProgressUpdate(const Status: string); 44 | public 45 | constructor Create(const Service: IOService; const ProgressHandler: EchoClientProgressHandler); 46 | 47 | function GetService: IOService; 48 | 49 | procedure Execute(const Data: TBytes; const Host: string; const Port: integer = 7); 50 | 51 | property Service: IOService read FService; 52 | end; 53 | 54 | function NewAsyncTCPEchoClient(const Service: IOService; const ProgressHandler: EchoClientProgressHandler): AsyncTCPEchoClient; 55 | begin 56 | result := AsyncTCPEchoClientImpl.Create(Service, ProgressHandler); 57 | end; 58 | 59 | { AsyncTCPEchoClientImpl } 60 | 61 | function AsyncTCPEchoClientImpl.ConnectCondition(const ErrorCode: IOErrorCode; const Endpoint: IPEndpoint): boolean; 62 | begin 63 | if (ErrorCode) then 64 | begin 65 | ProgressUpdate('Connection attempt failed: ' + ErrorCode.Message); 66 | end; 67 | 68 | ProgressUpdate('Connecting to ' + Endpoint); 69 | 70 | // we use this just for status updates 71 | result := True; 72 | end; 73 | 74 | procedure AsyncTCPEchoClientImpl.ConnectHandler(const ErrorCode: IOErrorCode; const Endpoint: IPEndpoint); 75 | begin 76 | if (ErrorCode) then 77 | begin 78 | ProgressUpdate('Connection attempt failed: ' + ErrorCode.Message); 79 | ProgressUpdate('Unable to connect to host'); 80 | Service.Stop; // TODO - better stopping 81 | exit; 82 | end; 83 | 84 | ProgressUpdate('Connected'); 85 | ProgressUpdate('Local endpoint: ' + FSocket.LocalEndpoint); 86 | ProgressUpdate('Remote endpoint: ' + FSocket.RemoteEndpoint); 87 | ProgressUpdate('Sending echo request'); 88 | 89 | FStream := NewAsyncSocketStream(FSocket); 90 | 91 | // ok, we're connected, so send the echo request 92 | AsyncWrite(FStream, FData, TransferAll(), WriteHandler); 93 | end; 94 | 95 | constructor AsyncTCPEchoClientImpl.Create(const Service: IOService; const ProgressHandler: EchoClientProgressHandler); 96 | begin 97 | inherited Create; 98 | 99 | FService := Service; 100 | FProgressHandler := ProgressHandler; 101 | end; 102 | 103 | procedure AsyncTCPEchoClientImpl.Execute(const Data: TBytes; const Host: string; const Port: integer); 104 | var 105 | qry: IPResolver.Query; 106 | res: IPResolver.Results; 107 | begin 108 | FData := Copy(Data); 109 | 110 | FSocket := NewTCPSocket(Service); 111 | 112 | qry := Query(IPProtocol.TCP.Unspecified, Host, IntToStr(Port)); 113 | 114 | ProgressUpdate('Resolving "' + Host + '"'); 115 | 116 | // TODO - implement async resolve 117 | res := IPResolver.Resolve(qry); 118 | 119 | // first we need to connect 120 | AsyncConnect(FSocket, res, ConnectCondition, ConnectHandler); 121 | end; 122 | 123 | function AsyncTCPEchoClientImpl.GetService: IOService; 124 | begin 125 | result := FService; 126 | end; 127 | 128 | procedure AsyncTCPEchoClientImpl.ProgressUpdate(const Status: string); 129 | begin 130 | if Assigned(FProgressHandler) then 131 | FProgressHandler(Status); 132 | end; 133 | 134 | procedure AsyncTCPEchoClientImpl.ReadHandler(const ErrorCode: IOErrorCode; const BytesTransferred: UInt64); 135 | var 136 | matches: boolean; 137 | begin 138 | if (ErrorCode) then 139 | RaiseLastOSError(ErrorCode.Value); 140 | 141 | // we got the response, compare with what we sent 142 | matches := CompareMem(FData, FResponseData, Min(Length(FData), BytesTransferred)); 143 | 144 | if (matches) then 145 | ProgressUpdate('Response matches, yay!') 146 | else 147 | ProgressUpdate('RESPONSE MISMATCH'); 148 | 149 | FSocket.Close(); 150 | 151 | // stopping to be improved 152 | Service.Stop; 153 | end; 154 | 155 | procedure AsyncTCPEchoClientImpl.WriteHandler(const ErrorCode: IOErrorCode; const BytesTransferred: UInt64); 156 | begin 157 | if (ErrorCode) then 158 | RaiseLastOSError(ErrorCode.Value); 159 | 160 | ProgressUpdate('Retrieving echo response'); 161 | 162 | // half close 163 | FSocket.Shutdown(SocketShutdownWrite); 164 | 165 | // zero our response buffer so we know we got the right stuff back 166 | FResponseData := nil; 167 | SetLength(FResponseData, Length(FData)); 168 | 169 | // finally read the echo response back 170 | AsyncRead(FStream, FResponseData, TransferAtLeast(Length(FData)), ReadHandler); 171 | end; 172 | 173 | end. 174 | -------------------------------------------------------------------------------- /Source/AsyncIO.StreamReader.pas: -------------------------------------------------------------------------------- 1 | unit AsyncIO.StreamReader; 2 | 3 | interface 4 | 5 | uses 6 | System.SysUtils, System.Classes; 7 | 8 | type 9 | StreamReader = interface 10 | {$REGION 'Property accessors'} 11 | function GetEncoding: TEncoding; 12 | function GetStream: TStream; 13 | function GetOwnsSourceStream: boolean; 14 | function GetEndOfStream: boolean; 15 | {$ENDREGION} 16 | 17 | /// 18 | /// 19 | /// Reads up to Count characters from the source stream. Returns an empty 20 | /// array if there's an error decoding the characters. 21 | /// 22 | /// 23 | function ReadChars(const CharCount: integer): TCharArray; 24 | 25 | /// 26 | /// 27 | /// Reads a single line of text from the source stream. 28 | /// Line breaks detected are LF, CR and CRLF. 29 | /// 30 | /// 31 | /// If no more data can be read from the source stream, it 32 | /// returns an empty string. 33 | /// 34 | /// 35 | function ReadLine: string; 36 | 37 | /// 38 | /// 39 | /// Reads text from the source stream until a delimiter is found or 40 | /// the end of the source stream is reached. 41 | /// 42 | /// 43 | /// If no more data can be read from the source stream, it 44 | /// returns an empty string. 45 | /// 46 | /// 47 | function ReadUntil(const Delimiter: UInt8): string; overload; 48 | 49 | /// 50 | /// 51 | /// Reads text from the source stream until a text delimiter is found or 52 | /// the end of the source stream is reached. The delimiter is encoded using 53 | /// the current Encoding, and the encoded delimiter is used for matching. 54 | /// 55 | /// 56 | /// If no more data can be read from the source stream, it 57 | /// returns an empty string. 58 | /// 59 | /// 60 | function ReadUntil(const Delimiter: string): string; overload; 61 | 62 | /// 63 | /// 64 | /// Reads any remaining text from the source stream. 65 | /// 66 | /// 67 | /// If no more data can be read from the source stream, it 68 | /// returns an empty string. 69 | /// 70 | /// 71 | function ReadToEnd: string; 72 | 73 | /// 74 | /// 75 | /// Encoding of the text to be read. 76 | /// 77 | /// 78 | property Encoding: TEncoding read GetEncoding; 79 | 80 | /// 81 | /// The buffered stream. Use this if you need to read aditional 82 | /// (possibly binary) data after reading text. 83 | /// 84 | property Stream: TStream read GetStream; 85 | property OwnsSourceStream: boolean read GetOwnsSourceStream; 86 | 87 | /// 88 | /// True if the end of the source stream was detected during the previous 89 | /// read operation. 90 | /// 91 | property EndOfStream: boolean read GetEndOfStream; 92 | end; 93 | 94 | function NewStreamReader(const Encoding: TEncoding; const Stream: TStream; const OwnsStream: boolean = False): StreamReader; 95 | 96 | implementation 97 | 98 | uses 99 | BufStream, BufStreamReader; 100 | 101 | type 102 | StreamReaderImpl = class(TInterfacedObject, StreamReader) 103 | strict private 104 | FStreamReader: BufferedStreamReader; 105 | public 106 | constructor Create(const Encoding: TEncoding; const Stream: TStream; const OwnsStream: boolean); 107 | destructor Destroy; override; 108 | 109 | function GetEncoding: TEncoding; 110 | function GetStream: TStream; 111 | function GetOwnsSourceStream: boolean; 112 | function GetEndOfStream: boolean; 113 | 114 | function ReadChars(const CharCount: Integer): System.TArray; 115 | function ReadLine: string; 116 | function ReadUntil(const Delimiter: Byte): string; overload; 117 | function ReadUntil(const Delimiter: string): string; overload; 118 | 119 | function ReadToEnd: string; 120 | end; 121 | 122 | function NewStreamReader(const Encoding: TEncoding; const Stream: TStream; const OwnsStream: boolean): StreamReader; 123 | begin 124 | result := StreamReaderImpl.Create(Encoding, Stream, OwnsStream); 125 | end; 126 | 127 | { StreamReaderImpl } 128 | 129 | constructor StreamReaderImpl.Create(const Encoding: TEncoding; 130 | const Stream: TStream; const OwnsStream: boolean); 131 | var 132 | opts: BufferedStreamReaderOptions; 133 | begin 134 | inherited Create; 135 | 136 | opts := []; 137 | if OwnsStream then 138 | Include(opts, BufferedStreamReaderOwnsSource); 139 | 140 | FStreamReader := BufferedStreamReader.Create(Stream, Encoding, opts); 141 | end; 142 | 143 | destructor StreamReaderImpl.Destroy; 144 | begin 145 | FStreamReader.Free; 146 | 147 | inherited; 148 | end; 149 | 150 | function StreamReaderImpl.GetEncoding: TEncoding; 151 | begin 152 | result := FStreamReader.Encoding; 153 | end; 154 | 155 | function StreamReaderImpl.GetEndOfStream: boolean; 156 | begin 157 | result := FStreamReader.EndOfStream; 158 | end; 159 | 160 | function StreamReaderImpl.GetOwnsSourceStream: boolean; 161 | begin 162 | result := FStreamReader.OwnsSourceStream; 163 | end; 164 | 165 | function StreamReaderImpl.GetStream: TStream; 166 | begin 167 | result := FStreamReader.Stream; 168 | end; 169 | 170 | function StreamReaderImpl.ReadChars(const CharCount: Integer): System.TArray; 171 | begin 172 | result := FStreamReader.ReadChars(CharCount); 173 | end; 174 | 175 | function StreamReaderImpl.ReadLine: string; 176 | begin 177 | result := FStreamReader.ReadLine; 178 | end; 179 | 180 | function StreamReaderImpl.ReadToEnd: string; 181 | begin 182 | result := FStreamReader.ReadToEnd; 183 | end; 184 | 185 | function StreamReaderImpl.ReadUntil(const Delimiter: string): string; 186 | begin 187 | result := FStreamReader.ReadUntil(Delimiter); 188 | end; 189 | 190 | function StreamReaderImpl.ReadUntil(const Delimiter: Byte): string; 191 | begin 192 | result := FStreamReader.ReadUntil(Delimiter); 193 | end; 194 | 195 | end. 196 | -------------------------------------------------------------------------------- /Source/AsyncIO.Coroutine.Net.IP.pas: -------------------------------------------------------------------------------- 1 | unit AsyncIO.Coroutine.Net.IP; 2 | 3 | interface 4 | 5 | uses 6 | AsyncIO, AsyncIO.OpResults, AsyncIO.Net.IP, AsyncIO.Coroutine; 7 | 8 | type 9 | ConnectResult = record 10 | {$REGION 'Implementation details'} 11 | strict private 12 | FRes: OpResult; 13 | FEndpoint: IPEndpoint; 14 | 15 | function GetValue: integer; 16 | function GetSuccess: boolean; 17 | function GetMessage: string; 18 | function GetResult: OpResult; 19 | private 20 | function GetEndpoint: IPEndpoint; 21 | {$ENDREGION} 22 | public 23 | class function Create(const Res: OpResult; const Endpoint: IPEndpoint): ConnectResult; static; 24 | 25 | class operator Implicit(const ConnectRes: ConnectResult): OpResult; 26 | 27 | procedure RaiseException(const AdditionalInfo: string = ''); 28 | 29 | property Value: integer read GetValue; 30 | 31 | property Success: boolean read GetSuccess; 32 | property Message: string read GetMessage; 33 | 34 | property Result: OpResult read GetResult; 35 | property Endpoint: IPEndpoint read GetEndpoint; 36 | end; 37 | 38 | function AsyncAccept(const Acceptor: IPAcceptor; const Peer: IPSocket; const Yield: YieldContext): OpResult; overload; 39 | 40 | function AsyncConnect(const Socket: IPSocket; const Endpoints: IPResolver.Results; const Yield: YieldContext): ConnectResult; overload; 41 | function AsyncConnect(const Socket: IPSocket; const Endpoints: TArray; const Yield: YieldContext): ConnectResult; overload; 42 | function AsyncConnect(const Socket: IPSocket; const Endpoints: IPResolver.Results; const Condition: ConnectCondition; const Yield: YieldContext): ConnectResult; overload; 43 | function AsyncConnect(const Socket: IPSocket; const Endpoints: TArray; const Condition: ConnectCondition; const Yield: YieldContext): ConnectResult; overload; 44 | 45 | implementation 46 | 47 | uses 48 | AsyncIO.Coroutine.Detail; 49 | 50 | function AsyncAccept(const Acceptor: IPAcceptor; const Peer: IPSocket; const Yield: YieldContext): OpResult; 51 | var 52 | yieldImpl: IYieldContext; 53 | handler: OpHandler; 54 | opRes: OpResult; 55 | begin 56 | yieldImpl := Yield; 57 | 58 | handler := 59 | procedure(const Res: OpResult) 60 | begin 61 | opRes := Res; 62 | // set return 63 | yieldImpl.SetServiceHandlerCoroutine(); 64 | end; 65 | 66 | Acceptor.AsyncAccept(Peer, handler); 67 | 68 | yieldImpl.Wait; 69 | 70 | result := opRes; 71 | end; 72 | 73 | function AsyncConnect(const Socket: IPSocket; const Endpoints: IPResolver.Results; const Yield: YieldContext): ConnectResult; 74 | var 75 | yieldImpl: IYieldContext; 76 | handler: ConnectHandler; 77 | connectRes: ConnectResult; 78 | begin 79 | yieldImpl := Yield; 80 | 81 | handler := 82 | procedure(const Res: OpResult; const Endpoint: IPEndpoint) 83 | begin 84 | connectRes := ConnectResult.Create(Res, Endpoint); 85 | // set return 86 | yieldImpl.SetServiceHandlerCoroutine(); 87 | end; 88 | 89 | AsyncIO.Net.IP.AsyncConnect(Socket, Endpoints, handler); 90 | 91 | yieldImpl.Wait; 92 | 93 | result := connectRes; 94 | end; 95 | 96 | function AsyncConnect(const Socket: IPSocket; const Endpoints: TArray; const Yield: YieldContext): ConnectResult; 97 | var 98 | yieldImpl: IYieldContext; 99 | handler: ConnectHandler; 100 | connectRes: ConnectResult; 101 | begin 102 | yieldImpl := Yield; 103 | 104 | handler := 105 | procedure(const Res: OpResult; const Endpoint: IPEndpoint) 106 | begin 107 | connectRes := ConnectResult.Create(Res, Endpoint); 108 | // set return 109 | yieldImpl.SetServiceHandlerCoroutine(); 110 | end; 111 | 112 | AsyncIO.Net.IP.AsyncConnect(Socket, Endpoints, handler); 113 | 114 | yieldImpl.Wait; 115 | 116 | result := connectRes; 117 | end; 118 | 119 | function AsyncConnect(const Socket: IPSocket; const Endpoints: IPResolver.Results; const Condition: ConnectCondition; const Yield: YieldContext): ConnectResult; 120 | var 121 | yieldImpl: IYieldContext; 122 | handler: ConnectHandler; 123 | connectRes: ConnectResult; 124 | begin 125 | yieldImpl := Yield; 126 | 127 | handler := 128 | procedure(const Res: OpResult; const Endpoint: IPEndpoint) 129 | begin 130 | connectRes := ConnectResult.Create(Res, Endpoint); 131 | // set return 132 | yieldImpl.SetServiceHandlerCoroutine(); 133 | end; 134 | 135 | AsyncIO.Net.IP.AsyncConnect(Socket, Endpoints, handler); 136 | 137 | yieldImpl.Wait; 138 | 139 | result := connectRes; 140 | end; 141 | 142 | function AsyncConnect(const Socket: IPSocket; const Endpoints: TArray; const Condition: ConnectCondition; const Yield: YieldContext): ConnectResult; 143 | var 144 | yieldImpl: IYieldContext; 145 | handler: ConnectHandler; 146 | connectRes: ConnectResult; 147 | begin 148 | yieldImpl := Yield; 149 | 150 | handler := 151 | procedure(const Res: OpResult; const Endpoint: IPEndpoint) 152 | begin 153 | connectRes := ConnectResult.Create(Res, Endpoint); 154 | // set return 155 | yieldImpl.SetServiceHandlerCoroutine(); 156 | end; 157 | 158 | AsyncIO.Net.IP.AsyncConnect(Socket, Endpoints, handler); 159 | 160 | yieldImpl.Wait; 161 | 162 | result := connectRes; 163 | end; 164 | 165 | { ConnectResult } 166 | 167 | class function ConnectResult.Create(const Res: OpResult; 168 | const Endpoint: IPEndpoint): ConnectResult; 169 | begin 170 | result.FRes := Res; 171 | result.FEndpoint := Endpoint; 172 | end; 173 | 174 | function ConnectResult.GetEndpoint: IPEndpoint; 175 | begin 176 | result := FEndpoint; 177 | end; 178 | 179 | function ConnectResult.GetMessage: string; 180 | begin 181 | result := FRes.Message; 182 | end; 183 | 184 | function ConnectResult.GetResult: OpResult; 185 | begin 186 | result := FRes; 187 | end; 188 | 189 | function ConnectResult.GetSuccess: boolean; 190 | begin 191 | result := FRes.Success; 192 | end; 193 | 194 | function ConnectResult.GetValue: integer; 195 | begin 196 | result := FRes.Value; 197 | end; 198 | 199 | class operator ConnectResult.Implicit( 200 | const ConnectRes: ConnectResult): OpResult; 201 | begin 202 | result := ConnectRes.FRes; 203 | end; 204 | 205 | procedure ConnectResult.RaiseException(const AdditionalInfo: string); 206 | begin 207 | FRes.RaiseException(AdditionalInfo); 208 | end; 209 | 210 | end. 211 | -------------------------------------------------------------------------------- /Source/AsyncIO.Detail.StreamBufferImpl.pas: -------------------------------------------------------------------------------- 1 | unit AsyncIO.Detail.StreamBufferImpl; 2 | 3 | interface 4 | 5 | uses 6 | System.SysUtils, System.Classes, AsyncIO; 7 | 8 | type 9 | StreamBufferImpl = class(TInterfacedObject, StreamBuffer.IStreamBuffer) 10 | strict private 11 | type 12 | StreamBufferStreamImpl = class(TStream) 13 | strict private 14 | FStreamBuffer: StreamBufferImpl; 15 | FPosition: Int64; 16 | protected 17 | function GetSize: Int64; override; 18 | procedure SetSize(NewSize: Longint); override; 19 | procedure SetSize(const NewSize: Int64); override; 20 | public 21 | constructor Create(const StreamBuffer: StreamBufferImpl); 22 | 23 | function Read(var Buffer; Count: Longint): Longint; override; 24 | function Write(const Buffer; Count: Longint): Longint; override; 25 | 26 | function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override; 27 | end; 28 | strict private 29 | FBuffer: TArray; 30 | FMaxBufferSize: integer; 31 | FCommitPosition: UInt64; 32 | FCommitSize: UInt32; 33 | FConsumeSize: UInt64; 34 | FStream: TStream; 35 | public 36 | constructor Create(const MaxBufferSize: UInt64); overload; 37 | 38 | destructor Destroy; override; 39 | 40 | function GetData: pointer; 41 | function GetBufferSize: UInt64; 42 | function GetMaxBufferSize: UInt64; 43 | function GetStream: TStream; 44 | 45 | function PrepareCommit(const Size: UInt32): MemoryBuffer; 46 | procedure Commit(const Size: UInt32); 47 | 48 | function PrepareConsume(const Size: UInt32): MemoryBuffer; 49 | procedure Consume(const Size: UInt32); 50 | 51 | property BufferSize: UInt64 read GetBufferSize; 52 | property Data: pointer read GetData; 53 | end; 54 | 55 | implementation 56 | 57 | uses 58 | System.Math; 59 | 60 | {$POINTERMATH ON} 61 | 62 | { StreamBufferImpl } 63 | 64 | procedure StreamBufferImpl.Commit(const Size: UInt32); 65 | begin 66 | if (Size > FCommitSize) then 67 | raise EArgumentException.Create('ByteStreamAdapter commit size larger than prepared size'); 68 | 69 | SetLength(FBuffer, FCommitPosition + Size); 70 | end; 71 | 72 | procedure StreamBufferImpl.Consume(const Size: UInt32); 73 | var 74 | len: UInt32; 75 | begin 76 | if (Size > FConsumeSize) then 77 | raise EArgumentException.Create('ByteStreamAdapter consume size larger than prepared size'); 78 | 79 | len := Length(FBuffer); 80 | Move(FBuffer[Size], FBuffer[0], len - Size); 81 | SetLength(FBuffer, len - Size); 82 | end; 83 | 84 | constructor StreamBufferImpl.Create(const MaxBufferSize: UInt64); 85 | begin 86 | inherited Create; 87 | 88 | FMaxBufferSize := MaxBufferSize; 89 | end; 90 | 91 | destructor StreamBufferImpl.Destroy; 92 | begin 93 | FStream.Free; 94 | inherited; 95 | end; 96 | 97 | function StreamBufferImpl.GetBufferSize: UInt64; 98 | begin 99 | result := Length(FBuffer); 100 | end; 101 | 102 | function StreamBufferImpl.GetData: pointer; 103 | begin 104 | result := @FBuffer[0]; 105 | end; 106 | 107 | function StreamBufferImpl.GetMaxBufferSize: UInt64; 108 | begin 109 | result := FMaxBufferSize; 110 | end; 111 | 112 | function StreamBufferImpl.GetStream: TStream; 113 | begin 114 | if (FStream = nil) then 115 | begin 116 | FStream := StreamBufferStreamImpl.Create(Self); 117 | end; 118 | result := FStream; 119 | end; 120 | 121 | function StreamBufferImpl.PrepareCommit(const Size: UInt32): MemoryBuffer; 122 | var 123 | bufSize: UInt32; 124 | begin 125 | bufSize := Length(FBuffer); 126 | SetLength(FBuffer, bufSize + Size); 127 | 128 | FCommitSize := Size; 129 | FCommitPosition := bufSize; 130 | 131 | result := MakeBuffer(@FBuffer[FCommitPosition], FCommitSize); 132 | end; 133 | 134 | function StreamBufferImpl.PrepareConsume(const Size: UInt32): MemoryBuffer; 135 | begin 136 | if (Size > BufferSize) then 137 | raise EArgumentException.Create('StreamBufferImpl.PrepareConsume size larger than buffer size'); 138 | 139 | FConsumeSize := Size; 140 | 141 | result := MakeBuffer(FBuffer, FConsumeSize); 142 | end; 143 | 144 | { StreamBufferImpl.StreamBufferStreamImpl } 145 | 146 | constructor StreamBufferImpl.StreamBufferStreamImpl.Create(const StreamBuffer: StreamBufferImpl); 147 | begin 148 | inherited Create; 149 | 150 | FStreamBuffer := StreamBuffer; 151 | end; 152 | 153 | function StreamBufferImpl.StreamBufferStreamImpl.GetSize: Int64; 154 | begin 155 | result := FStreamBuffer.GetBufferSize; 156 | end; 157 | 158 | function StreamBufferImpl.StreamBufferStreamImpl.Read(var Buffer; Count: Integer): Longint; 159 | var 160 | data: PByte; 161 | len: NativeInt; 162 | begin 163 | result := 0; 164 | if (Count <= 0) then 165 | exit; 166 | if (FPosition < 0) then 167 | exit; 168 | if (FPosition >= FStreamBuffer.BufferSize) then 169 | exit; 170 | 171 | // non-consuming read 172 | data := PByte(FStreamBuffer.Data) + FPosition; 173 | len := Min(Int64(Count), FStreamBuffer.BufferSize - FPosition); 174 | Move(data^, Buffer, len); 175 | 176 | FPosition := FPosition + len; 177 | 178 | result := len; 179 | end; 180 | 181 | procedure StreamBufferImpl.StreamBufferStreamImpl.SetSize(NewSize: Integer); 182 | begin 183 | SetSize(Int64(NewSize)); 184 | end; 185 | 186 | function StreamBufferImpl.StreamBufferStreamImpl.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; 187 | begin 188 | case Origin of 189 | soBeginning: FPosition := Offset; 190 | soCurrent: FPosition := FPosition + Offset; 191 | soEnd: FPosition := FStreamBuffer.BufferSize - Offset; 192 | else 193 | raise ENotSupportedException.CreateFmt( 194 | 'StreamBufferImpl.StreamBufferStreamImpl.Seek: Invalid seek origin (%d)', 195 | [Ord(Origin)]); 196 | end; 197 | result := FPosition; 198 | end; 199 | 200 | procedure StreamBufferImpl.StreamBufferStreamImpl.SetSize(const NewSize: Int64); 201 | begin 202 | //raise ENotSupportedException.Create('StreamBufferStreamImpl.SetSize'); 203 | end; 204 | 205 | function StreamBufferImpl.StreamBufferStreamImpl.Write(const Buffer; Count: Integer): Longint; 206 | var 207 | buf: MemoryBuffer; 208 | begin 209 | if (FPosition <> FStreamBuffer.BufferSize) then 210 | raise ENotSupportedException.Create('StreamBufferImpl.StreamBufferStreamImpl.Write: Unsupported writing position (must be at end of stream)'); 211 | 212 | result := 0; 213 | if (Count <= 0) then 214 | exit; 215 | 216 | buf := FStreamBuffer.PrepareCommit(Count); 217 | 218 | Move(Buffer, buf.Data^, Count); 219 | 220 | FStreamBuffer.Commit(Count); 221 | 222 | FPosition := FPosition + Count; 223 | 224 | result := Count; 225 | end; 226 | 227 | end. 228 | -------------------------------------------------------------------------------- /Examples/HTTP/AsyncHttpServer.dpr: -------------------------------------------------------------------------------- 1 | program AsyncHttpServer; 2 | 3 | {$APPTYPE CONSOLE} 4 | 5 | {$R *.res} 6 | 7 | uses 8 | System.SysUtils, 9 | System.IOUtils, 10 | BufStream in '..\..\..\BufferedStreamReader\BufStream.pas', 11 | BufStreamReader in '..\..\..\BufferedStreamReader\BufStreamReader.pas', 12 | EncodingHelper in '..\..\..\BufferedStreamReader\EncodingHelper.pas', 13 | RegularExpr.Detail in '..\..\..\RegularExpr\RegularExpr.Detail.pas', 14 | RegularExpr in '..\..\..\RegularExpr\RegularExpr.pas', 15 | AsyncIO.Detail in '..\..\Source\AsyncIO.Detail.pas', 16 | AsyncIO.Detail.StreamBufferImpl in '..\..\Source\AsyncIO.Detail.StreamBufferImpl.pas', 17 | AsyncIO.OpResults in '..\..\Source\AsyncIO.OpResults.pas', 18 | AsyncIO.Filesystem.Detail in '..\..\Source\AsyncIO.Filesystem.Detail.pas', 19 | AsyncIO.Filesystem in '..\..\Source\AsyncIO.Filesystem.pas', 20 | AsyncIO.Net.IP.Detail in '..\..\Source\AsyncIO.Net.IP.Detail.pas', 21 | AsyncIO.Net.IP.Detail.TCPImpl in '..\..\Source\AsyncIO.Net.IP.Detail.TCPImpl.pas', 22 | AsyncIO.Net.IP in '..\..\Source\AsyncIO.Net.IP.pas', 23 | AsyncIO in '..\..\Source\AsyncIO.pas', 24 | AsyncIO.StreamReader in '..\..\Source\AsyncIO.StreamReader.pas', 25 | AsyncHttpServer.Impl in 'AsyncHttpServer.Impl.pas', 26 | AsyncHttpServer.Mime in 'AsyncHttpServer.Mime.pas', 27 | AsyncHttpServer.Headers in 'AsyncHttpServer.Headers.pas', 28 | AsyncHttpServer.Request in 'AsyncHttpServer.Request.pas', 29 | AsyncHttpServer.RequestParser in 'AsyncHttpServer.RequestParser.pas', 30 | AsyncHttpServer.Response in 'AsyncHttpServer.Response.pas', 31 | AsyncHttpServer.RequestHandler in 'AsyncHttpServer.RequestHandler.pas', 32 | AsyncHttpServer.Connection in 'AsyncHttpServer.Connection.pas', 33 | HttpDateTime in 'HttpDateTime.pas'; 34 | 35 | //function MakeRequestBuffer(const RequestData: string): StreamBuffer; 36 | //var 37 | // data: TBytes; 38 | // buf: MemoryBuffer; 39 | //begin 40 | // data := TEncoding.ASCII.GetBytes(RequestData); 41 | // result := StreamBuffer.Create(); 42 | // buf := result.PrepareCommit(Length(data)); 43 | // Move(data[0], buf.Data^, buf.Size); 44 | // result.Commit(buf.Size); 45 | //end; 46 | // 47 | //procedure Run; 48 | //var 49 | // r: HttpRequest; 50 | // p: HttpRequestParser; 51 | // req: string; 52 | // reqBuffer: StreamBuffer; 53 | // res: HttpRequestState; 54 | // hdr: HttpHeader; 55 | //begin 56 | // r := NewHttpRequest; 57 | // p := NewHttpRequestParser; 58 | // 59 | // req := 60 | // 'GET /index.html'; 61 | // 62 | // reqBuffer := MakeRequestBuffer(req); 63 | // 64 | // res := p.Parse(r, reqBuffer); 65 | // if (res = HttpRequestStateNeedMoreData) then 66 | // begin 67 | // WriteLn('Indeterminate'); 68 | // end 69 | // else if (res = HttpRequestStateInvalid) then 70 | // begin 71 | // WriteLn('Invalid'); 72 | // end 73 | // else 74 | // begin 75 | // WriteLn('Valid'); 76 | // end; 77 | // 78 | // req := 79 | //// 'GET /index.html HTTP/1.0' + #13#10 + 80 | // ' HTTP/1.0' + #13#10 + 81 | // 'If-Modified-Since: Sat, 29 Oct 1994 19:43:31 GMT' + #13#10 + 82 | // 'Referer: http://www.w3.org/hypertext' + #13#10 + 83 | // ' /DataSources/Overview.html' + #13#10 + 84 | // #13#10; 85 | // 86 | // reqBuffer := MakeRequestBuffer(req); 87 | // 88 | // res := p.Parse(r, reqBuffer); 89 | // 90 | // if (res = HttpRequestStateNeedMoreData) then 91 | // begin 92 | // WriteLn('Indeterminate'); 93 | // end 94 | // else if (res = HttpRequestStateInvalid) then 95 | // begin 96 | // WriteLn('Invalid'); 97 | // end 98 | // else 99 | // begin 100 | // WriteLn('Valid'); 101 | // 102 | // WriteLn(r.Method); 103 | // WriteLn(r.URI); 104 | // WriteLn(r.HttpVersionMajor); 105 | // WriteLn(r.HttpVersionMinor); 106 | // 107 | // for hdr in r.Headers do 108 | // begin 109 | // WriteLn(hdr.Name, ' => "', hdr.Value, '"'); 110 | // end; 111 | // end; 112 | // 113 | // WriteLn(reqBuffer.BufferSize); 114 | //end; 115 | 116 | //procedure Run; 117 | //var 118 | // response: HttpResponse; 119 | // sb: StreamBuffer; 120 | // sr: StreamReader; 121 | // buf: MemoryBuffer; 122 | //begin 123 | // response := StandardResponse(StatusNotModified); 124 | // 125 | // sb := response.ToBuffer(); 126 | // 127 | // sb.Stream.Position := 0; 128 | // 129 | // sr := NewStreamReader(TEncoding.ASCII, sb.Stream); 130 | // 131 | // WriteLn(sr.ReadToEnd); 132 | //end; 133 | 134 | //procedure Run; 135 | //var 136 | // service: IOService; 137 | // mime: MimeRegistry; 138 | // reqhandler: HttpRequestHandler; 139 | // request: HttpRequest; 140 | // response: HttpResponse; 141 | // header: HttpHeader; 142 | //begin 143 | // service := NewIOService(); 144 | // mime := NewMimeRegistry(); 145 | // reqhandler := NewHttpRequestHandler(service, 'c:\temp\', mime); 146 | // 147 | // request.Method := 'GET'; 148 | // request.URI := '/music/171355.jpg'; 149 | // request.HttpVersionMajor := 1; 150 | // request.HttpVersionMinor := 0; 151 | // 152 | // response := reqhandler.HandleRequest(request); 153 | // 154 | // WriteLn(response.Status.ToString()); 155 | // 156 | // for header in response.Headers do 157 | // begin 158 | // WriteLn(header.Name, ' = ', header.Value); 159 | // end; 160 | //end; 161 | 162 | procedure PrintUsage; 163 | begin 164 | WriteLn('Usage:'); 165 | WriteLn; 166 | WriteLn(' AsyncHttpServer docroot [localaddress] [port]'); 167 | WriteLn; 168 | WriteLn(' docroot Root directory for server'); 169 | WriteLn(' localaddress Address which server will listen on, default is 0.0.0.0'); 170 | WriteLn(' port Port which server will listen on, default is 80'); 171 | WriteLn; 172 | end; 173 | 174 | procedure Run; 175 | var 176 | localAddress: string; 177 | port: integer; 178 | docRoot: string; 179 | httpServer: AsyncHttpSrv; 180 | mime: MimeRegistry; 181 | begin 182 | localAddress := '0.0.0.0'; 183 | port := 80; 184 | 185 | if (ParamCount < 1) then 186 | begin 187 | PrintUsage; 188 | exit; 189 | end; 190 | 191 | docRoot := ParamStr(1); 192 | docRoot := TPath.GetFullPath(docRoot); 193 | 194 | if (not DirectoryExists(docRoot)) then 195 | raise EArgumentException.CreateFmt('DocRoot does not exist: "%s"', [docRoot]); 196 | 197 | if (ParamCount > 1) then 198 | localAddress := ParamStr(2); 199 | 200 | if (ParamCount > 2) then 201 | port := StrToIntDef(ParamStr(3), -1); 202 | 203 | if (port <= 0) then 204 | raise EArgumentException.CreateFmt('Invalid port: %d', [port]); 205 | 206 | mime := NewMimeRegistry; 207 | 208 | httpServer := NewAsyncHttpSrv(localAddress, port, docRoot, mime); 209 | httpServer.Run; 210 | end; 211 | 212 | 213 | begin 214 | try 215 | Run; 216 | except 217 | on E: Exception do 218 | Writeln(E.ClassName, ': ', E.Message); 219 | end; 220 | 221 | WriteLn('Done...'); 222 | ReadLn; 223 | end. 224 | -------------------------------------------------------------------------------- /Source/AsyncIO.Coroutine.pas: -------------------------------------------------------------------------------- 1 | unit AsyncIO.Coroutine; 2 | 3 | interface 4 | 5 | uses 6 | AsyncIO, AsyncIO.OpResults, AsyncIO.Coroutine.Detail; 7 | 8 | type 9 | IOServiceCoroutineContext = interface 10 | ['{6D2114D3-0061-404A-90C3-5531C5FE96CB}'] 11 | {$REGION 'Property accessors'} 12 | function GetService: IOService; 13 | {$ENDREGION} 14 | 15 | property Service: IOService read GetService; 16 | end; 17 | 18 | YieldContext = record 19 | {$REGION 'Implementation details'} 20 | strict private 21 | FImpl: IYieldContext; 22 | private 23 | property Impl: IYieldContext read FImpl; 24 | public 25 | class operator Implicit(const Yield: YieldContext): IYieldContext; 26 | {$ENDREGION} 27 | public 28 | // assign nil to free implementation 29 | class operator Implicit(const Impl: IYieldContext): YieldContext; 30 | end; 31 | 32 | CoroutineHandler = reference to procedure(const Yield: YieldContext); 33 | 34 | IOResult = record 35 | {$REGION 'Implementation details'} 36 | strict private 37 | FRes: OpResult; 38 | FBytesTransferred: UInt64; 39 | 40 | function GetValue: integer; 41 | function GetSuccess: boolean; 42 | function GetMessage: string; 43 | function GetResult: OpResult; 44 | {$ENDREGION} 45 | public 46 | class function Create(const Res: OpResult; const BytesTransferred: UInt64): IOResult; static; 47 | 48 | class operator Implicit(const IORes: IOResult): OpResult; 49 | 50 | procedure RaiseException(const AdditionalInfo: string = ''); 51 | 52 | property Value: integer read GetValue; 53 | 54 | property Success: boolean read GetSuccess; 55 | property Message: string read GetMessage; 56 | 57 | property Result: OpResult read GetResult; 58 | property BytesTransferred: UInt64 read FBytesTransferred; 59 | end; 60 | 61 | function NewIOServiceCoroutineContext(const Service: IOService): IOServiceCoroutineContext; 62 | 63 | function NewYieldContext(const ServiceContext: IOServiceCoroutineContext): YieldContext; 64 | 65 | procedure Spawn(const ServiceContext: IOServiceCoroutineContext; Coroutine: CoroutineHandler); overload; 66 | 67 | function AsyncRead(const Stream: AsyncStream; const Buffer: MemoryBuffer; const CompletionCondition: IOCompletionCondition; const Yield: YieldContext): IOResult; overload; 68 | function AsyncRead(const Stream: AsyncStream; const Buffer: StreamBuffer; const CompletionCondition: IOCompletionCondition; const Yield: YieldContext): IOResult; overload; 69 | 70 | function AsyncWrite(const Stream: AsyncStream; const Buffer: MemoryBuffer; const CompletionCondition: IOCompletionCondition; const Yield: YieldContext): IOResult; overload; 71 | function AsyncWrite(const Stream: AsyncStream; const Buffer: StreamBuffer; const CompletionCondition: IOCompletionCondition; const Yield: YieldContext): IOResult; overload; 72 | 73 | implementation 74 | 75 | uses 76 | System.SysUtils, AsyncIO.Coroutine.Detail.Fiber; 77 | 78 | function NewIOServiceCoroutineContext(const Service: IOService): IOServiceCoroutineContext; 79 | begin 80 | result := IOServiceCoroutineContextImpl.Create(Service); 81 | end; 82 | 83 | function NewYieldContext(const ServiceContext: IOServiceCoroutineContext): YieldContext; 84 | begin 85 | result := YieldContextImpl.Create(ServiceContext); 86 | end; 87 | 88 | procedure Spawn(const ServiceContext: IOServiceCoroutineContext; Coroutine: CoroutineHandler); 89 | var 90 | yield: YieldContext; 91 | begin 92 | yield := NewYieldContext(ServiceContext); 93 | 94 | ServiceContext.Service.Post( 95 | procedure 96 | begin 97 | Coroutine(yield); 98 | end 99 | ); 100 | end; 101 | 102 | function AsyncRead(const Stream: AsyncStream; const Buffer: MemoryBuffer; const CompletionCondition: IOCompletionCondition; const Yield: YieldContext): IOResult; overload; 103 | var 104 | yieldImpl: IYieldContext; 105 | handler: IOHandler; 106 | ioRes: IOResult; 107 | begin 108 | yieldImpl := Yield; 109 | 110 | handler := 111 | procedure(const Res: OpResult; const BytesTransferred: UInt64) 112 | begin 113 | ioRes := IOResult.Create(Res, BytesTransferred); 114 | // set return 115 | yieldImpl.SetServiceHandlerCoroutine(); 116 | end; 117 | 118 | AsyncRead(Stream, Buffer, CompletionCondition, handler); 119 | 120 | yieldImpl.Wait; 121 | 122 | result := ioRes; 123 | end; 124 | 125 | function AsyncRead(const Stream: AsyncStream; const Buffer: StreamBuffer; const CompletionCondition: IOCompletionCondition; const Yield: YieldContext): IOResult; 126 | var 127 | yieldImpl: IYieldContext; 128 | handler: IOHandler; 129 | ioRes: IOResult; 130 | begin 131 | yieldImpl := Yield; 132 | 133 | handler := 134 | procedure(const Res: OpResult; const BytesTransferred: UInt64) 135 | begin 136 | ioRes := IOResult.Create(Res, BytesTransferred); 137 | // set return 138 | yieldImpl.SetServiceHandlerCoroutine(); 139 | end; 140 | 141 | AsyncRead(Stream, Buffer, CompletionCondition, handler); 142 | 143 | yieldImpl.Wait; 144 | 145 | result := ioRes; 146 | end; 147 | 148 | function AsyncWrite(const Stream: AsyncStream; const Buffer: MemoryBuffer; const CompletionCondition: IOCompletionCondition; const Yield: YieldContext): IOResult; overload; 149 | var 150 | yieldImpl: IYieldContext; 151 | handler: IOHandler; 152 | ioRes: IOResult; 153 | begin 154 | yieldImpl := Yield; 155 | 156 | handler := 157 | procedure(const Res: OpResult; const BytesTransferred: UInt64) 158 | begin 159 | ioRes := IOResult.Create(Res, BytesTransferred); 160 | // set return 161 | yieldImpl.SetServiceHandlerCoroutine(); 162 | end; 163 | 164 | AsyncWrite(Stream, Buffer, CompletionCondition, handler); 165 | 166 | yieldImpl.Wait; 167 | 168 | result := ioRes; 169 | end; 170 | 171 | function AsyncWrite(const Stream: AsyncStream; const Buffer: StreamBuffer; const CompletionCondition: IOCompletionCondition; const Yield: YieldContext): IOResult; 172 | var 173 | yieldImpl: IYieldContext; 174 | handler: IOHandler; 175 | ioRes: IOResult; 176 | begin 177 | yieldImpl := Yield; 178 | 179 | handler := 180 | procedure(const Res: OpResult; const BytesTransferred: UInt64) 181 | begin 182 | ioRes := IOResult.Create(Res, BytesTransferred); 183 | // set return 184 | yieldImpl.SetServiceHandlerCoroutine(); 185 | end; 186 | 187 | AsyncWrite(Stream, Buffer, CompletionCondition, handler); 188 | 189 | yieldImpl.Wait; 190 | 191 | result := ioRes; 192 | end; 193 | 194 | { YieldContext } 195 | 196 | class operator YieldContext.Implicit(const Impl: IYieldContext): YieldContext; 197 | begin 198 | result.FImpl := Impl; 199 | end; 200 | 201 | class operator YieldContext.Implicit(const Yield: YieldContext): IYieldContext; 202 | begin 203 | result := Yield.Impl; 204 | end; 205 | 206 | { IOResult } 207 | 208 | class function IOResult.Create(const Res: OpResult; 209 | const BytesTransferred: UInt64): IOResult; 210 | begin 211 | result.FRes := Res; 212 | result.FBytesTransferred := BytesTransferred; 213 | end; 214 | 215 | function IOResult.GetMessage: string; 216 | begin 217 | result := FRes.Message; 218 | end; 219 | 220 | function IOResult.GetResult: OpResult; 221 | begin 222 | result := FRes; 223 | end; 224 | 225 | function IOResult.GetSuccess: boolean; 226 | begin 227 | result := FRes.Success; 228 | end; 229 | 230 | function IOResult.GetValue: integer; 231 | begin 232 | result := FRes.Value; 233 | end; 234 | 235 | class operator IOResult.Implicit(const IORes: IOResult): OpResult; 236 | begin 237 | result := IORes.FRes; 238 | end; 239 | 240 | procedure IOResult.RaiseException(const AdditionalInfo: string); 241 | begin 242 | FRes.RaiseException(AdditionalInfo); 243 | end; 244 | 245 | end. 246 | -------------------------------------------------------------------------------- /Source/AsyncIO.Coroutine.Detail.Fiber.pas: -------------------------------------------------------------------------------- 1 | unit AsyncIO.Coroutine.Detail.Fiber; 2 | 3 | interface 4 | 5 | uses 6 | AsyncIO, AsyncIO.OpResults, AsyncIO.Coroutine, AsyncIO.Coroutine.Detail; 7 | 8 | type 9 | TFiberMethod = procedure of object; 10 | 11 | CoroutineFiberImplBase = class abstract(TInterfacedObject, CoroutineFiber) 12 | strict private 13 | FFiber: pointer; 14 | FOwnsFiber: boolean; 15 | protected 16 | procedure InitFiber(const Fiber: pointer; const OwnsFiber: boolean); 17 | public 18 | constructor Create; 19 | destructor Destroy; override; 20 | 21 | procedure SwitchTo; 22 | end; 23 | 24 | CoroutineThreadFiberImpl = class(CoroutineFiberImplBase) 25 | public 26 | constructor Create; 27 | end; 28 | 29 | CoroutineFiberImpl = class(CoroutineFiberImplBase) 30 | strict private 31 | FProc: TFiberMethod; 32 | FFiberMethod: TMethod; 33 | public 34 | constructor Create(const Proc: TFiberMethod); 35 | end; 36 | 37 | IOServiceCoroutineHandler = interface 38 | ['{AFF5B520-9084-4279-9C9A-1C24AF9E645D}'] 39 | procedure SetHandlerCoroutine(const HandlerCoroutine: CoroutineFiber); 40 | end; 41 | 42 | IOServiceCoroutineContextImpl = class(TInterfacedObject, IOServiceCoroutineContext, CoroutineFiber, IOServiceCoroutineHandler) 43 | strict private 44 | FService: IOService; 45 | FCoroutine: CoroutineFiber; 46 | FHandlerCoroutine: CoroutineFiber; 47 | public 48 | constructor Create(const Service: IOService); 49 | 50 | function GetService: IOService; 51 | 52 | procedure SetHandlerCoroutine(const HandlerCoroutine: CoroutineFiber); 53 | 54 | procedure RunProc; 55 | 56 | property Service: IOService read FService; 57 | property Coroutine: CoroutineFiber read FCoroutine implements CoroutineFiber; 58 | property HandlerCoroutine: CoroutineFiber read FHandlerCoroutine; 59 | end; 60 | 61 | YieldContextImpl = class(TInterfacedObject, IYieldContext) 62 | strict private 63 | FServiceContext: IOServiceCoroutineContext; 64 | FCoroutine: CoroutineFiber; 65 | FValid: boolean; 66 | protected 67 | procedure SetValid(); 68 | public 69 | constructor Create(const ServiceContext: IOServiceCoroutineContext); 70 | 71 | procedure Wait; 72 | procedure SetServiceHandlerCoroutine; 73 | 74 | property ServiceContext: IOServiceCoroutineContext read FServiceContext; 75 | property Coroutine: CoroutineFiber read FCoroutine; 76 | property Valid: boolean read FValid; 77 | end; 78 | 79 | implementation 80 | 81 | uses 82 | WinAPI.Windows, System.SysUtils; 83 | 84 | type 85 | TFiberStartRoutine = procedure(lpParameter: pointer); stdcall; 86 | 87 | function CreateFiberEx( 88 | {_In_} dwStackCommitSize: SIZE_T; 89 | {_In_} dwStackReserveSize: SIZE_T; 90 | {_In_} dwFlags: DWORD; 91 | {_In_} lpStartAddress: TFiberStartRoutine; 92 | {_In_opt_} lpParameter: pointer 93 | ): pointer; stdcall; external 'kernel32.dll'; 94 | 95 | function ConvertThreadToFiberEx( 96 | {_In_opt_} lpParameter: LPVOID; 97 | {_In_} dwFlags: DWORD 98 | ): pointer; stdcall; external 'kernel32.dll'; 99 | 100 | function IsThreadAFiber(): boolean; external 'kernel32.dll'; 101 | 102 | function GetCurrentFiber(): pointer; 103 | {$IF defined(MSWINDOWS)} 104 | {$IF defined(CPUX86)} 105 | asm 106 | { return (PVOID) (ULONG_PTR) __readfsdword (0x10);} 107 | mov eax, fs:[$10] 108 | end; 109 | {$ELSEIF defined(CPUX64)} 110 | asm 111 | mov rax, gs:[$20] 112 | end; 113 | {$ELSE} 114 | {$MESSAGE FATAL 'Unsupported CPU'} 115 | {$ENDIF} 116 | {$ELSE} 117 | {$MESSAGE FATAL 'Unsupported platform'} 118 | {$ENDIF} 119 | 120 | procedure FiberStartRoutine(lpParameter: pointer); stdcall; 121 | var 122 | proc: TFiberMethod; 123 | begin 124 | proc := TFiberMethod(PMethod(lpParameter)^); 125 | 126 | proc(); 127 | 128 | // should never return from that, so... 129 | raise EProgrammerNotFound.Create('Fiber procedure returned'); 130 | end; 131 | 132 | function CurrentCoroutineFiber(): CoroutineFiber; 133 | begin 134 | result := CoroutineThreadFiberImpl.Create(); 135 | end; 136 | 137 | function NewCoroutineFiber(const Proc: TFiberMethod): CoroutineFiber; 138 | begin 139 | result := CoroutineFiberImpl.Create(Proc); 140 | end; 141 | 142 | { CoroutineFiberImplBase } 143 | 144 | constructor CoroutineFiberImplBase.Create; 145 | begin 146 | inherited Create; 147 | end; 148 | 149 | destructor CoroutineFiberImplBase.Destroy; 150 | begin 151 | if (FOwnsFiber) then 152 | DeleteFiber(FFiber); 153 | 154 | inherited; 155 | end; 156 | 157 | procedure CoroutineFiberImplBase.InitFiber(const Fiber: pointer; 158 | const OwnsFiber: boolean); 159 | begin 160 | FFiber := Fiber; 161 | FOwnsFiber := OwnsFiber; 162 | end; 163 | 164 | procedure CoroutineFiberImplBase.SwitchTo; 165 | begin 166 | SwitchToFiber(FFiber); 167 | end; 168 | 169 | { CoroutineThreadFiberImpl } 170 | 171 | constructor CoroutineThreadFiberImpl.Create; 172 | var 173 | isCallingThreadFiber: boolean; 174 | fiber: pointer; 175 | begin 176 | inherited Create; 177 | 178 | isCallingThreadFiber := IsThreadAFiber(); 179 | 180 | if (isCallingThreadFiber) then 181 | begin 182 | fiber := GetCurrentFiber() 183 | end 184 | else 185 | begin 186 | fiber := ConvertThreadToFiberEx(nil, 0); 187 | if (fiber = nil) then 188 | RaiseLastOSError(); 189 | end; 190 | 191 | InitFiber(fiber, False); 192 | end; 193 | 194 | { CoroutineFiberImpl } 195 | 196 | constructor CoroutineFiberImpl.Create(const Proc: TFiberMethod); 197 | var 198 | fiber: pointer; 199 | begin 200 | inherited Create; 201 | 202 | FProc := Proc; 203 | FFiberMethod := TMethod(FProc); 204 | 205 | fiber := CreateFiberEx(0, 0, 0, FiberStartRoutine, @FFiberMethod); 206 | if (fiber = nil) then 207 | RaiseLastOSError(); 208 | 209 | 210 | InitFiber(fiber, True); 211 | end; 212 | 213 | { IOServiceCoroutineContextImpl } 214 | 215 | constructor IOServiceCoroutineContextImpl.Create(const Service: IOService); 216 | begin 217 | inherited Create; 218 | 219 | FService := Service; 220 | FCoroutine := NewCoroutineFiber(RunProc); 221 | end; 222 | 223 | function IOServiceCoroutineContextImpl.GetService: IOService; 224 | begin 225 | result := FService; 226 | end; 227 | 228 | procedure IOServiceCoroutineContextImpl.RunProc; 229 | begin 230 | while (not Service.Stopped) do 231 | begin 232 | FHandlerCoroutine := nil; 233 | Service.RunOne; 234 | // if the async handler assigned us a 235 | // coroutine, switch to that now 236 | // otherwise just run again 237 | if (Assigned(HandlerCoroutine)) then 238 | HandlerCoroutine.SwitchTo(); 239 | end; 240 | end; 241 | 242 | procedure IOServiceCoroutineContextImpl.SetHandlerCoroutine( 243 | const HandlerCoroutine: CoroutineFiber); 244 | begin 245 | FHandlerCoroutine := HandlerCoroutine; 246 | end; 247 | 248 | { YieldContextImpl } 249 | 250 | constructor YieldContextImpl.Create(const ServiceContext: IOServiceCoroutineContext); 251 | begin 252 | inherited Create; 253 | 254 | FServiceContext := ServiceContext; 255 | FCoroutine := CurrentCoroutineFiber(); 256 | end; 257 | 258 | procedure YieldContextImpl.SetServiceHandlerCoroutine; 259 | var 260 | serviceHandler: IOServiceCoroutineHandler; 261 | begin 262 | // make sure service context coroutine switches back to us 263 | // this ensures the handler is fully processed before 264 | // execution is switched back to us 265 | serviceHandler := ServiceContext as IOServiceCoroutineHandler; 266 | 267 | serviceHandler.SetHandlerCoroutine(Coroutine); 268 | end; 269 | 270 | procedure YieldContextImpl.SetValid; 271 | begin 272 | FValid := True; 273 | end; 274 | 275 | procedure YieldContextImpl.Wait; 276 | var 277 | serviceCoroutine: CoroutineFiber; 278 | begin 279 | serviceCoroutine := ServiceContext as CoroutineFiber; 280 | 281 | serviceCoroutine.SwitchTo(); 282 | end; 283 | 284 | //{ IOFutureImpl } 285 | // 286 | //function IOFutureImpl.GetBytesTransferred: UInt64; 287 | //begin 288 | // result := FBytesTransferred; 289 | //end; 290 | // 291 | //function IOFutureImpl.GetHandler: IOHandler; 292 | //begin 293 | // result := 294 | // procedure(const Res: OpResult; const BytesTransferred: UInt64) 295 | // var 296 | // serviceHandler: IOServiceCoroutineHandler; 297 | // begin 298 | // FResult := Res; 299 | // FBytesTransferred := BytesTransferred; 300 | // 301 | // // make sure service context coroutine switches back to us 302 | // // this ensures the handler is fully processed before 303 | // // execution is switched back to us 304 | // serviceHandler := ServiceContext as IOServiceCoroutineHandler; 305 | // serviceHandler.SetHandlerCoroutine(Coroutine); 306 | // end; 307 | //end; 308 | // 309 | //function IOFutureImpl.GetResult: OpResult; 310 | //begin 311 | // result := FResult; 312 | //end; 313 | 314 | end. 315 | -------------------------------------------------------------------------------- /dev/AsyncIO.Test.Socket.pas: -------------------------------------------------------------------------------- 1 | unit AsyncIO.Test.Socket; 2 | 3 | interface 4 | 5 | procedure RunSocketTest; 6 | 7 | implementation 8 | 9 | uses 10 | System.SysUtils, System.DateUtils, AsyncIO, AsyncIO.ErrorCodes, AsyncIO.Net.IP, 11 | System.Math; 12 | 13 | procedure TestAddress; 14 | var 15 | addr4: IPv4Address; 16 | addr6: IPv6Address; 17 | 18 | addr: IPAddress; 19 | begin 20 | addr4 := IPv4Address.Loopback; 21 | addr := addr4; 22 | WriteLn('IPv4 loopback: ' + addr); 23 | 24 | addr6 := IPv6Address.Loopback; 25 | addr := addr6; 26 | WriteLn('IPv6 loopback: ' + addr); 27 | 28 | addr := IPAddress('192.168.42.2'); 29 | WriteLn('IP address: ' + addr); 30 | WriteLn(' is IPv4: ' + BoolToStr(addr.IsIPv4, True)); 31 | WriteLn(' is IPv6: ' + BoolToStr(addr.IsIPv6, True)); 32 | 33 | addr := IPAddress('abcd::1%42'); 34 | WriteLn('IP address: ' + addr); 35 | WriteLn(' is IPv4: ' + BoolToStr(addr.IsIPv4, True)); 36 | WriteLn(' is IPv6: ' + BoolToStr(addr.IsIPv6, True)); 37 | WriteLn(' has scope: ' + IntToStr(addr.AsIPv6.ScopeID)); 38 | 39 | WriteLn; 40 | end; 41 | 42 | procedure TestEndpoint; 43 | var 44 | endp: IPEndpoint; 45 | begin 46 | endp := Endpoint(IPAddressFamily.v6, 1234); 47 | WriteLn('IPv6 listening endpoint: ' + endp); 48 | 49 | endp := Endpoint(IPAddress('192.168.42.1'), 9876); 50 | WriteLn('IPv4 connection endpoint: ' + endp); 51 | 52 | endp := Endpoint(IPAddress('1234:abcd::1'), 0); 53 | WriteLn('IPv6 connection endpoint: ' + endp); 54 | 55 | WriteLn; 56 | end; 57 | 58 | procedure TestResolve; 59 | var 60 | qry: IPResolver.Query; 61 | res: IPResolver.Results; 62 | ip: IPResolver.Entry; 63 | begin 64 | qry := Query(IPProtocol.TCPProtocol.v6, 'google.com', '80', [ResolveAllMatching]); 65 | res := IPResolver.Resolve(qry); 66 | 67 | WriteLn('Resolved ' + qry.HostName + ':' + qry.ServiceName + ' as'); 68 | for ip in res do 69 | begin 70 | WriteLn(' ' + ip.Endpoint.Address); 71 | end; 72 | end; 73 | 74 | type 75 | EchoClient = class 76 | private 77 | FRequest: string; 78 | FRequestData: TBytes; 79 | FResponseData: TBytes; 80 | FSocket: IPStreamSocket; 81 | FStream: AsyncSocketStream; 82 | 83 | procedure HandleConnect(const ErrorCode: IOErrorCode); 84 | procedure HandleRead(const ErrorCode: IOErrorCode; const BytesTransferred: UInt64); 85 | procedure HandleWrite(const ErrorCode: IOErrorCode; const BytesTransferred: UInt64); 86 | public 87 | constructor Create(const Service: IOService; 88 | const ServerEndpoint: IPEndpoint; 89 | const Request: string); 90 | end; 91 | 92 | procedure TestEcho; 93 | var 94 | qry: IPResolver.Query; 95 | res: IPResolver.Results; 96 | ip: IPResolver.Entry; 97 | ios: IOService; 98 | client: EchoClient; 99 | r: Int64; 100 | begin 101 | qry := Query(IPProtocol.TCP.v6, 'localhost', '7', [ResolveAllMatching]); 102 | res := IPResolver.Resolve(qry); 103 | 104 | for ip in res do 105 | // TODO - make connect take resolver result set, connect until success 106 | break; 107 | 108 | ios := nil; 109 | client := nil; 110 | try 111 | ios := NewIOService; 112 | 113 | WriteLn('Connecting to ' + ip.Endpoint); 114 | 115 | client := EchoClient.Create(ios, ip.Endpoint, 'Hello Internet!'); 116 | 117 | r := ios.Run; 118 | 119 | WriteLn; 120 | WriteLn('Done'); 121 | WriteLn(Format('%d handlers executed', [r])); 122 | finally 123 | client.Free; 124 | end; 125 | end; 126 | 127 | type 128 | EchoServer = class 129 | private 130 | FData: TBytes; 131 | FAcceptor: IPAcceptor; 132 | FPeerSocket: IPStreamSocket; 133 | FStream: AsyncSocketStream; 134 | 135 | procedure HandleAccept(const ErrorCode: IOErrorCode); 136 | procedure HandleRead(const ErrorCode: IOErrorCode; const BytesTransferred: UInt64); 137 | procedure HandleWrite(const ErrorCode: IOErrorCode; const BytesTransferred: UInt64); 138 | public 139 | constructor Create(const Service: IOService; const LocalEndpoint: IPEndpoint); 140 | end; 141 | 142 | procedure TestEchoServer; 143 | var 144 | ip: IPEndpoint; 145 | ios: IOService; 146 | server: EchoServer; 147 | r: Int64; 148 | begin 149 | ios := nil; 150 | server := nil; 151 | try 152 | ip := Endpoint(IPAddressFamily.v6, 7); 153 | 154 | ios := NewIOService; 155 | 156 | WriteLn('Listening on ' + ip); 157 | 158 | server := EchoServer.Create(ios, ip); 159 | 160 | r := ios.Run; 161 | 162 | WriteLn; 163 | WriteLn('Done'); 164 | WriteLn(Format('%d handlers executed', [r])); 165 | finally 166 | server.Free; 167 | end; 168 | end; 169 | 170 | procedure RunSocketTest; 171 | begin 172 | // TestAddress; 173 | // TestEndpoint; 174 | // TestResolve; 175 | 176 | // TestEcho; 177 | 178 | TestEchoServer; 179 | end; 180 | 181 | { EchoClient } 182 | 183 | procedure EchoClient.HandleConnect(const ErrorCode: IOErrorCode); 184 | begin 185 | if (ErrorCode) then 186 | RaiseLastOSError(ErrorCode.Value); 187 | 188 | WriteLn('Client connected'); 189 | WriteLn('Local endpoint: ' + FSocket.LocalEndpoint); 190 | WriteLn('Remote endpoint: ' + FSocket.RemoteEndpoint); 191 | WriteLn('Sending echo request'); 192 | 193 | FRequestData := TEncoding.Unicode.GetBytes(FRequest); 194 | 195 | // we'll use a socket stream for the actual read/write operations 196 | FStream := NewAsyncSocketStream(FSocket); 197 | 198 | AsyncWrite(FStream, FRequestData, TransferAll(), HandleWrite); 199 | end; 200 | 201 | constructor EchoClient.Create( 202 | const Service: IOService; 203 | const ServerEndpoint: IPEndpoint; 204 | const Request: string); 205 | begin 206 | inherited Create; 207 | 208 | FRequest := Request; 209 | FSocket := NewTCPSocket(Service); 210 | 211 | FSocket.AsyncConnect(ServerEndpoint, HandleConnect); 212 | end; 213 | 214 | procedure EchoClient.HandleRead(const ErrorCode: IOErrorCode; 215 | const BytesTransferred: UInt64); 216 | var 217 | s: string; 218 | responseMatches: boolean; 219 | begin 220 | if (ErrorCode) then 221 | RaiseLastOSError(ErrorCode.Value); 222 | 223 | s := TEncoding.Unicode.GetString(FResponseData, 0, BytesTransferred); 224 | 225 | WriteLn('Echo reply: "' + s + '"'); 226 | 227 | // compare request and reply 228 | responseMatches := (Length(FRequestData) = Length(FResponseData)) and 229 | CompareMem(@FRequestData[0], @FResponseData[0], Length(FRequestData)); 230 | 231 | if (responseMatches) then 232 | WriteLn('Response matches, yay') 233 | else 234 | WriteLn('RESPONSE DOES NOT MATCH'); 235 | 236 | FSocket.Close(); 237 | 238 | // and we're done... 239 | FStream.Socket.Service.Stop; 240 | end; 241 | 242 | procedure EchoClient.HandleWrite(const ErrorCode: IOErrorCode; 243 | const BytesTransferred: UInt64); 244 | begin 245 | if (ErrorCode) then 246 | RaiseLastOSError(ErrorCode.Value); 247 | 248 | // half close 249 | FSocket.Shutdown(SocketShutdownWrite); 250 | 251 | // zero our response buffer so we know we got the right stuff back 252 | FResponseData := nil; 253 | SetLength(FResponseData, Length(FRequestData)); 254 | 255 | AsyncRead(FStream, FResponseData, TransferAtLeast(Length(FResponseData)), HandleRead); 256 | end; 257 | 258 | { EchoServer } 259 | 260 | constructor EchoServer.Create(const Service: IOService; const LocalEndpoint: IPEndpoint); 261 | begin 262 | inherited Create; 263 | 264 | FAcceptor := NewTCPAcceptor(Service, LocalEndpoint); 265 | FPeerSocket := NewTCPSocket(Service); 266 | 267 | FAcceptor.AsyncAccept(FPeerSocket, HandleAccept); 268 | end; 269 | 270 | procedure EchoServer.HandleAccept(const ErrorCode: IOErrorCode); 271 | begin 272 | if (ErrorCode) then 273 | RaiseLastOSError(ErrorCode.Value); 274 | 275 | WriteLn('Client connected'); 276 | WriteLn('Local endpoint: ' + FPeerSocket.LocalEndpoint); 277 | WriteLn('Remote endpoint: ' + FPeerSocket.RemoteEndpoint); 278 | WriteLn('Receiving echo request'); 279 | 280 | FData := nil; 281 | SetLength(FData, 512); 282 | 283 | FPeerSocket.AsyncReceive(FData, HandleRead); 284 | end; 285 | 286 | procedure EchoServer.HandleRead(const ErrorCode: IOErrorCode; const BytesTransferred: UInt64); 287 | begin 288 | if (ErrorCode) then 289 | RaiseLastOSError(ErrorCode.Value); 290 | 291 | WriteLn(Format('Received %d bytes', [BytesTransferred])); 292 | 293 | SetLength(FData, BytesTransferred); 294 | 295 | // use stream to write result so we reply it all 296 | FStream := NewAsyncSocketStream(FPeerSocket); 297 | 298 | AsyncWrite(FStream, FData, TransferAll(), HandleWrite); 299 | end; 300 | 301 | procedure EchoServer.HandleWrite(const ErrorCode: IOErrorCode; const BytesTransferred: UInt64); 302 | begin 303 | if (ErrorCode) then 304 | RaiseLastOSError(ErrorCode.Value); 305 | 306 | WriteLn(Format('Sent %d bytes', [BytesTransferred])); 307 | WriteLn('Shutting down...'); 308 | 309 | // deviate from echo protocol, shut down once write completes 310 | FPeerSocket.Shutdown(); 311 | FPeerSocket.Close(); 312 | 313 | FPeerSocket.Service.Stop; 314 | end; 315 | 316 | end. 317 | -------------------------------------------------------------------------------- /Examples/HTTP/AsyncHttpClient.Impl.pas: -------------------------------------------------------------------------------- 1 | unit AsyncHttpClient.Impl; 2 | 3 | interface 4 | 5 | uses 6 | System.SysUtils, AsyncIO, AsyncIO.OpResults, AsyncIO.Net.IP; 7 | 8 | type 9 | HttpClientProgressHandler = reference to procedure(const Status: string); 10 | HttpClientResponseHandler = reference to procedure(const Headers: string; const ResponseData: TBytes); 11 | 12 | AsyncHttpCli = interface 13 | {$REGION 'Property accessors'} 14 | function GetService: IOService; 15 | function GetProgressHandler: HttpClientProgressHandler; 16 | 17 | procedure SetProgressHandler(const Value: HttpClientProgressHandler); 18 | {$ENDREGION} 19 | 20 | procedure Get(const URL: string); 21 | 22 | property Service: IOService read GetService; 23 | property ProgressHandler: HttpClientProgressHandler read GetProgressHandler write SetProgressHandler; 24 | end; 25 | 26 | function NewAsyncHttpClient(const Service: IOService; const ResponseHandler: HttpClientResponseHandler): AsyncHttpCli; 27 | 28 | implementation 29 | 30 | uses 31 | AsyncIO.StreamReader; 32 | 33 | type 34 | AsyncHttpCliImpl = class(TInterfacedObject, AsyncHttpCli) 35 | private 36 | FService: IOService; 37 | FProgressHandler: HttpClientProgressHandler; 38 | FResponseHandler: HttpClientResponseHandler; 39 | FHost: string; 40 | FPath: string; 41 | FPort: integer; 42 | FUsername: string; 43 | FPassword: string; 44 | FSocket: IPStreamSocket; 45 | FStream: AsyncSocketStream; 46 | FResponseBuffer: StreamBuffer; 47 | 48 | function ConnectCondition(const Res: OpResult; const Endpoint: IPEndpoint): boolean; 49 | procedure ConnectHandler(const Res: OpResult; const Endpoint: IPEndpoint); 50 | procedure ReadHandler(const Res: OpResult; const BytesTransferred: UInt64); 51 | procedure WriteHandler(const Res: OpResult; const BytesTransferred: UInt64); 52 | 53 | procedure ProgressUpdate(const Status: string); 54 | procedure HandleResponse(const Headers: string; const ResponseData: TBytes); 55 | 56 | procedure ParseURL(const URL: string); 57 | public 58 | constructor Create(const Service: IOService; const ResponseHandler: HttpClientResponseHandler); 59 | 60 | function GetService: IOService; 61 | 62 | procedure Get(const URL: string); 63 | function GetProgressHandler: HttpClientProgressHandler; 64 | 65 | procedure SetProgressHandler(const Value: HttpClientProgressHandler); 66 | 67 | property Service: IOService read FService; 68 | property Host: string read FHost; 69 | property Port: integer read FPort; 70 | property Username: string read FUsername; 71 | property Password: string read FPassword; 72 | end; 73 | 74 | function NewAsyncHttpClient(const Service: IOService; const ResponseHandler: HttpClientResponseHandler): AsyncHttpCli; 75 | begin 76 | result := AsyncHttpCliImpl.Create(Service, ResponseHandler); 77 | end; 78 | 79 | { AsyncHttpClientImpl } 80 | 81 | function AsyncHttpCliImpl.ConnectCondition(const Res: OpResult; 82 | const Endpoint: IPEndpoint): boolean; 83 | begin 84 | if (not Res.Success) then 85 | begin 86 | ProgressUpdate('Connection attempt failed: ' + Res.Message); 87 | end; 88 | 89 | ProgressUpdate('Connecting to ' + Endpoint); 90 | 91 | // we use this just for status updates 92 | result := True; 93 | end; 94 | 95 | procedure AsyncHttpCliImpl.ConnectHandler(const Res: OpResult; 96 | const Endpoint: IPEndpoint); 97 | var 98 | request: string; 99 | requestData: TBytes; 100 | begin 101 | if (not Res.Success) then 102 | begin 103 | ProgressUpdate('Connection attempt failed: ' + Res.Message); 104 | ProgressUpdate('Unable to connect to host'); 105 | Service.Stop; // TODO - better stopping 106 | exit; 107 | end; 108 | 109 | ProgressUpdate('Connected'); 110 | ProgressUpdate('Local endpoint: ' + FSocket.LocalEndpoint); 111 | ProgressUpdate('Remote endpoint: ' + FSocket.RemoteEndpoint); 112 | ProgressUpdate('Sending GET request'); 113 | 114 | FStream := NewAsyncSocketStream(FSocket); 115 | 116 | // Form the request. We specify the "Connection: close" header so that the 117 | // server will close the socket after transmitting the response. This will 118 | // allow us to treat all data up until the EOF as the content. 119 | request := 120 | 'GET ' + FPath + ' HTTP/1.0' + #13#10 121 | + 'Host: ' + FHost + #13#10 122 | + 'Accept: */*' + #13#10 123 | + 'Connection: close' + #13#10 124 | + #13#10; 125 | 126 | requestData := TEncoding.ASCII.GetBytes(request); 127 | 128 | // ok, we're connected, so send the GET request 129 | AsyncWrite(FStream, requestData, TransferAll(), WriteHandler); 130 | end; 131 | 132 | constructor AsyncHttpCliImpl.Create(const Service: IOService; 133 | const ResponseHandler: HttpClientResponseHandler); 134 | begin 135 | inherited Create; 136 | 137 | FService := Service; 138 | FResponseHandler := ResponseHandler; 139 | end; 140 | 141 | procedure AsyncHttpCliImpl.Get(const URL: string); 142 | var 143 | qry: IPResolver.Query; 144 | res: IPResolver.Results; 145 | begin 146 | ParseURL(URL); 147 | 148 | FSocket := NewTCPSocket(Service); 149 | 150 | qry := Query(IPProtocol.TCP.Unspecified, Host, IntToStr(Port)); 151 | 152 | ProgressUpdate('Resolving "' + Host + '"'); 153 | 154 | // TODO - implement async resolve 155 | res := IPResolver.Resolve(qry); 156 | 157 | // first we need to connect 158 | AsyncConnect(FSocket, res, ConnectCondition, ConnectHandler); 159 | end; 160 | 161 | function AsyncHttpCliImpl.GetProgressHandler: HttpClientProgressHandler; 162 | begin 163 | result := FProgressHandler; 164 | end; 165 | 166 | function AsyncHttpCliImpl.GetService: IOService; 167 | begin 168 | result := FService; 169 | end; 170 | 171 | procedure AsyncHttpCliImpl.HandleResponse(const Headers: string; 172 | const ResponseData: TBytes); 173 | begin 174 | if (Assigned(FResponseHandler)) then 175 | FResponseHandler(Headers, ResponseData); 176 | end; 177 | 178 | procedure AsyncHttpCliImpl.ParseURL(const URL: string); 179 | 180 | procedure RaiseURLError(const Msg: string); 181 | begin 182 | raise EArgumentException.CreateFmt('%s: "%s"', [Msg, URL]); 183 | end; 184 | 185 | var 186 | s: string; 187 | i: integer; 188 | begin 189 | FHost := ''; 190 | FPath := ''; 191 | FUsername := ''; 192 | FPassword := ''; 193 | FPort := 0; 194 | 195 | s := URL; 196 | 197 | i := s.IndexOf('http://'); 198 | if (i < 0) then 199 | RaiseURLError('Invalid URL'); 200 | 201 | s := s.Remove(0, Length('http://')); 202 | 203 | i := s.IndexOf('/'); 204 | if (i < 0) then 205 | begin 206 | FHost := s; 207 | end 208 | else 209 | begin 210 | FHost := s.Substring(0, i); 211 | FPath := s.Remove(0, i); 212 | end; 213 | 214 | if (FPath = '') then 215 | FPath := '/'; 216 | 217 | // extract credentials if present 218 | s := FHost; 219 | i := s.IndexOf('@'); 220 | if (i >= 0) then 221 | begin 222 | FHost := s.Substring(i+1); 223 | s := s.Remove(0, i+1); 224 | i := s.IndexOf(':'); 225 | if (i < 0) then 226 | begin 227 | FUsername := s; 228 | end 229 | else 230 | begin 231 | FUsername := s.Substring(0, i); 232 | FPassword := s.Remove(0, i+1); 233 | end; 234 | end; 235 | 236 | // extract port 237 | s:= FHost; 238 | i := s.IndexOf(':'); 239 | if (i >= 0) then 240 | begin 241 | FHost := s.Substring(0, i); 242 | s := s.Remove(0, i+1); 243 | FPort := StrToIntDef(s, -1); 244 | if (FPort <= 0) then 245 | RaiseURLError('Invalid port in URL'); 246 | end; 247 | 248 | if (FPort <= 0) then 249 | FPort := 80; 250 | end; 251 | 252 | procedure AsyncHttpCliImpl.ProgressUpdate(const Status: string); 253 | begin 254 | if (Assigned(FProgressHandler)) then 255 | FProgressHandler(Status); 256 | end; 257 | 258 | procedure AsyncHttpCliImpl.ReadHandler(const Res: OpResult; 259 | const BytesTransferred: UInt64); 260 | var 261 | headers: string; 262 | responseData: TBytes; 263 | reader: StreamReader; 264 | begin 265 | if (not Res.Success) then 266 | RaiseLastOSError(Res.Value); 267 | 268 | FSocket.Close(); 269 | 270 | // stopping to be improved 271 | Service.Stop; 272 | 273 | reader := NewStreamReader(TEncoding.ASCII, FResponseBuffer.Stream); 274 | 275 | headers := reader.ReadUntil(#13#10#13#10); 276 | 277 | // read response data 278 | SetLength(responseData, reader.Stream.Size - reader.Stream.Position); 279 | reader.Stream.ReadBuffer(responseData, Length(responseData)); 280 | 281 | HandleResponse(headers, responseData); 282 | end; 283 | 284 | procedure AsyncHttpCliImpl.SetProgressHandler( 285 | const Value: HttpClientProgressHandler); 286 | begin 287 | FProgressHandler := Value; 288 | end; 289 | 290 | procedure AsyncHttpCliImpl.WriteHandler(const Res: OpResult; 291 | const BytesTransferred: UInt64); 292 | begin 293 | if (not Res.Success) then 294 | RaiseLastOSError(Res.Value); 295 | 296 | // half close 297 | FSocket.Shutdown(SocketShutdownWrite); 298 | 299 | // zero our response buffer so we know we got the right stuff back 300 | FResponseBuffer := StreamBuffer.Create(); 301 | 302 | // finally read the http response back 303 | // server will close socket when done, so read it all 304 | // for simplicity, just assume we can hold it all in memory 305 | AsyncRead(FStream, FResponseBuffer, TransferAll(), ReadHandler); 306 | end; 307 | 308 | end. 309 | -------------------------------------------------------------------------------- /Examples/HTTP/AsyncHttpServer.RequestHandler.pas: -------------------------------------------------------------------------------- 1 | unit AsyncHttpServer.RequestHandler; 2 | 3 | interface 4 | 5 | uses 6 | AsyncIO, AsyncHttpServer.Mime, AsyncHttpServer.Request, AsyncHttpServer.Response; 7 | 8 | type 9 | HttpRequestHandler = interface 10 | ['{AC26AF7B-589F-41D1-8449-995ECDADB2B4}'] 11 | {$REGION 'Property accessors'} 12 | function GetService: IOService; 13 | {$ENDREGION} 14 | 15 | function HandleRequest(const Request: HttpRequest): HttpResponse; 16 | 17 | property Service: IOService read GetService; 18 | end; 19 | 20 | function NewHttpRequestHandler(const Service: IOService; const DocRoot: string; const Mime: MimeRegistry): HttpRequestHandler; 21 | 22 | implementation 23 | 24 | uses 25 | WinAPI.Windows, System.SysUtils, System.Math, System.IOUtils, EncodingHelper, 26 | AsyncIO.Filesystem, AsyncHttpServer.Headers, HttpDateTime; 27 | 28 | const 29 | HTTP_GET_METHOD = 'GET'; 30 | HTTP_HEAD_METHOD = 'HEAD'; 31 | 32 | // I shouldn't complain, it's not even a decade since Vista was released... 33 | function GetFileSizeEx(hFile: THandle; out lpFileSize: int64): BOOL; stdcall; external kernel32; 34 | 35 | type 36 | URLParts = record 37 | Path: string; 38 | Query: string; 39 | end; 40 | 41 | function DecodeURLSegment(const Input: string; out Output: string; const PlusToSpace: boolean): boolean; 42 | var 43 | i, v: integer; 44 | c: char; 45 | hs: string; 46 | validHex: boolean; 47 | encc: string; 48 | begin 49 | result := False; 50 | Output := ''; 51 | 52 | i := 0; 53 | while (i < Input.Length) do 54 | begin 55 | c := Input.Chars[i]; 56 | if (c = '%') then 57 | begin 58 | hs := '$' + Input.Substring(i+1, 2); 59 | if (hs.Length <> 3) then 60 | exit; 61 | 62 | validHex := TryStrToInt(hs, v); 63 | if (not validHex) then 64 | exit; 65 | 66 | // assume encoded character is in default encoding 67 | encc := TEncoding.Default.GetString(PByte(@v), 0, 1); 68 | Output := Output + encc; 69 | i := i + 3; 70 | end 71 | else if (PlusToSpace and (c = '+')) then 72 | begin 73 | Output := Output + ' '; 74 | i := i + 1; 75 | end 76 | else 77 | begin 78 | Output := Output + c; 79 | i := i + 1; 80 | end; 81 | end; 82 | 83 | result := True; 84 | end; 85 | 86 | function DecodeURL(const URL: string; out Decoded: URLParts): boolean; 87 | var 88 | path: string; 89 | query: string; 90 | paramIndex, queryIndex, pathEndIndex: integer; 91 | begin 92 | // here we assume the URL represents an absolute path 93 | 94 | paramIndex := URL.IndexOf(';'); 95 | queryIndex := URL.IndexOf('?'); 96 | 97 | path := ''; 98 | query := ''; 99 | 100 | if ((paramIndex < 0) and (queryIndex < 0)) then 101 | begin 102 | // no path parameters nor query segment 103 | path := URL; 104 | end 105 | else 106 | begin 107 | if ((paramIndex < 0) or ((queryIndex >= 0) and (queryIndex < paramIndex))) then 108 | begin 109 | pathEndIndex := queryIndex; // no path parameter separator in path segment 110 | end 111 | else 112 | begin 113 | pathEndIndex := paramIndex; // path stops at path parameter separator 114 | end; 115 | 116 | path := URL.Substring(0, pathEndIndex); 117 | 118 | if (queryIndex > 0) then 119 | begin 120 | query := URL.Substring(queryIndex + 1, URL.Length); 121 | end; 122 | end; 123 | 124 | // now to decode the segments 125 | result := DecodeURLSegment(path, Decoded.Path, False); 126 | if (not result) then 127 | exit; 128 | 129 | result := DecodeURLSegment(query, Decoded.Query, True); 130 | if (not result) then 131 | exit; 132 | end; 133 | 134 | type 135 | HttpRequestHandlerImpl = class(TInterfacedObject, HttpRequestHandler) 136 | strict private 137 | FService: IOService; 138 | FDocRoot: string; 139 | FMime: MimeRegistry; 140 | 141 | function GetFullPath(const Filename: string): string; 142 | 143 | function GetFileModifiedTime(const FileStream: AsyncFileStream): TSystemTime; 144 | function GetFileSize(const FileStream: AsyncFileStream): Int64; 145 | 146 | procedure Log(const Msg: string); 147 | public 148 | constructor Create(const Service: IOService; const DocRoot: string; const Mime: MimeRegistry); 149 | 150 | function GetService: IOService; 151 | 152 | function HandleRequest(const Request: HttpRequest): HttpResponse; 153 | 154 | property Service: IOService read FService; 155 | property DocRoot: string read FDocRoot; 156 | property Mime: MimeRegistry read FMime; 157 | end; 158 | 159 | function NewHttpRequestHandler(const Service: IOService; const DocRoot: string; const Mime: MimeRegistry): HttpRequestHandler; 160 | begin 161 | result := HttpRequestHandlerImpl.Create(Service, DocRoot, Mime); 162 | end; 163 | 164 | { HttpRequestHandlerImpl } 165 | 166 | constructor HttpRequestHandlerImpl.Create(const Service: IOService; const DocRoot: string; const Mime: MimeRegistry); 167 | begin 168 | inherited Create; 169 | 170 | FService := Service; 171 | FDocRoot := IncludeTrailingPathDelimiter(DocRoot); 172 | FMime := Mime; 173 | end; 174 | 175 | function HttpRequestHandlerImpl.GetFileSize( 176 | const FileStream: AsyncFileStream): Int64; 177 | var 178 | res: boolean; 179 | begin 180 | res := GetFileSizeEx(FileStream.Handle, result); 181 | if (not res) then 182 | RaiseLastOSError(); 183 | end; 184 | 185 | function HttpRequestHandlerImpl.GetFileModifiedTime( 186 | const FileStream: AsyncFileStream): TSystemTime; 187 | var 188 | res: boolean; 189 | mt: TFileTime; 190 | begin 191 | res := WinAPI.Windows.GetFileTime(FileStream.Handle, nil, nil, @mt); 192 | if (not res) then 193 | RaiseLastOSError(); 194 | 195 | res := WinAPI.Windows.FileTimeToSystemTime(mt, result); 196 | if (not res) then 197 | RaiseLastOSError(); 198 | end; 199 | 200 | function HttpRequestHandlerImpl.GetFullPath(const Filename: string): string; 201 | var 202 | p: TArray; 203 | i: integer; 204 | begin 205 | result := ''; 206 | 207 | p := Filename.Split(['/']); 208 | 209 | // we know start of Filename starts with / and ends with a filename 210 | Delete(p, 0, 1); 211 | i := 0; 212 | while (i < Length(p)) do 213 | begin 214 | if (p[i] = '..') then 215 | begin 216 | // check if we're attempting to escape root 217 | if (i < 1) then 218 | exit; 219 | 220 | i := i - 1; 221 | Delete(p, i, 2); 222 | end 223 | else 224 | begin 225 | i := i + 1; 226 | end; 227 | end; 228 | 229 | result := DocRoot + string.Join(PathDelim, p); 230 | end; 231 | 232 | function HttpRequestHandlerImpl.GetService: IOService; 233 | begin 234 | result := FService; 235 | end; 236 | 237 | function HttpRequestHandlerImpl.HandleRequest(const Request: HttpRequest): HttpResponse; 238 | var 239 | url: URLParts; 240 | urlValid: boolean; 241 | filename: string; 242 | fileExists: boolean; 243 | contentStream: AsyncFileStream; 244 | fileSize: Int64; 245 | modifiedTime: TSystemTime; 246 | hasIfModifiedSinceTime: boolean; 247 | ifModifiedSinceTime: TSystemTime; 248 | contentModified: boolean; 249 | contentType: string; 250 | begin 251 | try 252 | if (Request.HttpVersionMajor <> 1) then 253 | begin 254 | result := StandardResponse(StatusNotImplemented); 255 | exit; 256 | end; 257 | 258 | if ((Request.Method <> HTTP_GET_METHOD) and (Request.Method <> HTTP_HEAD_METHOD)) then 259 | begin 260 | result := StandardResponse(StatusNotImplemented); 261 | exit; 262 | end; 263 | 264 | urlValid := DecodeURL(Request.URI, url); 265 | 266 | // require absolute path 267 | urlValid := urlValid 268 | and (url.Path.Length > 0) 269 | and (url.Path.Chars[0] = '/') 270 | and (url.Path.IndexOf('//') < 0); 271 | 272 | if (not urlValid) then 273 | begin 274 | result := StandardResponse(StatusBadRequest); 275 | exit; 276 | end; 277 | 278 | filename := url.Path; 279 | if (filename.EndsWith('/')) then 280 | filename := filename + 'index.html'; 281 | 282 | filename := GetFullPath(filename); 283 | 284 | // check if all went well with resolving the full path 285 | // and that file actually exists 286 | fileExists := (filename <> '') and TFile.Exists(filename); 287 | 288 | if (not fileExists) then 289 | begin 290 | result := StandardResponse(StatusNotFound); 291 | exit; 292 | end; 293 | 294 | // all looking good 295 | // now to open the file and get the details for the headers 296 | contentStream := NewAsyncFileStream(Service, filename, fcOpenExisting, faRead, fsRead); 297 | 298 | fileSize := GetFileSize(contentStream); 299 | modifiedTime := GetFileModifiedTime(contentStream); 300 | // TESTING 301 | //DateTimeToSystemTime(Now(), modifiedTime); 302 | contentType := Mime.FileExtensionToMimeType(ExtractFileExt(filename)); 303 | 304 | hasIfModifiedSinceTime := TryHttpDateToSystemTime(Request.Headers.Value['If-Modified-Since'], ifModifiedSinceTime); 305 | 306 | if (hasIfModifiedSinceTime) then 307 | begin 308 | contentModified := CompareSystemTime(modifiedTime, ifModifiedSinceTime) > 0; 309 | 310 | if (not contentModified) then 311 | begin 312 | // content not modified, so we just send a standard 304 response 313 | result := StandardResponse(StatusNotModified); 314 | exit; 315 | end; 316 | end; 317 | 318 | result.Status := StatusOK; 319 | result.Headers.Value['Content-Length'] := IntToStr(fileSize); 320 | result.Headers.Value['Content-Type'] := contentType; 321 | result.Headers.Value['Last-Modified'] := SystemTimeToHttpDate(modifiedTime); 322 | 323 | // only send content if we've been asked to 324 | if (Request.Method = HTTP_GET_METHOD) then 325 | begin 326 | result.Content := nil; 327 | result.ContentStream := contentStream; 328 | end; 329 | except 330 | on E: Exception do 331 | begin 332 | Log('Error processing request'); 333 | Log(Format('Exception: [%s] %s', [E.ClassName, E.Message])); 334 | Log(Format('Request: %s %s HTTP/%d.%d', [Request.Method, Request.URI, Request.HttpVersionMajor, '.', Request.HttpVersionMinor])); 335 | 336 | result := StandardResponse(StatusInternalServerError); 337 | end; 338 | end; 339 | end; 340 | 341 | procedure HttpRequestHandlerImpl.Log(const Msg: string); 342 | begin 343 | WriteLn(Msg); 344 | end; 345 | 346 | end. 347 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Apache License 2 | Version 2.0, January 2004 3 | http://www.apache.org/licenses/ 4 | 5 | TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION 6 | 7 | 1. Definitions. 8 | 9 | "License" shall mean the terms and conditions for use, reproduction, 10 | and distribution as defined by Sections 1 through 9 of this document. 11 | 12 | "Licensor" shall mean the copyright owner or entity authorized by 13 | the copyright owner that is granting the License. 14 | 15 | "Legal Entity" shall mean the union of the acting entity and all 16 | other entities that control, are controlled by, or are under common 17 | control with that entity. For the purposes of this definition, 18 | "control" means (i) the power, direct or indirect, to cause the 19 | direction or management of such entity, whether by contract or 20 | otherwise, or (ii) ownership of fifty percent (50%) or more of the 21 | outstanding shares, or (iii) beneficial ownership of such entity. 22 | 23 | "You" (or "Your") shall mean an individual or Legal Entity 24 | exercising permissions granted by this License. 25 | 26 | "Source" form shall mean the preferred form for making modifications, 27 | including but not limited to software source code, documentation 28 | source, and configuration files. 29 | 30 | "Object" form shall mean any form resulting from mechanical 31 | transformation or translation of a Source form, including but 32 | not limited to compiled object code, generated documentation, 33 | and conversions to other media types. 34 | 35 | "Work" shall mean the work of authorship, whether in Source or 36 | Object form, made available under the License, as indicated by a 37 | copyright notice that is included in or attached to the work 38 | (an example is provided in the Appendix below). 39 | 40 | "Derivative Works" shall mean any work, whether in Source or Object 41 | form, that is based on (or derived from) the Work and for which the 42 | editorial revisions, annotations, elaborations, or other modifications 43 | represent, as a whole, an original work of authorship. For the purposes 44 | of this License, Derivative Works shall not include works that remain 45 | separable from, or merely link (or bind by name) to the interfaces of, 46 | the Work and Derivative Works thereof. 47 | 48 | "Contribution" shall mean any work of authorship, including 49 | the original version of the Work and any modifications or additions 50 | to that Work or Derivative Works thereof, that is intentionally 51 | submitted to Licensor for inclusion in the Work by the copyright owner 52 | or by an individual or Legal Entity authorized to submit on behalf of 53 | the copyright owner. For the purposes of this definition, "submitted" 54 | means any form of electronic, verbal, or written communication sent 55 | to the Licensor or its representatives, including but not limited to 56 | communication on electronic mailing lists, source code control systems, 57 | and issue tracking systems that are managed by, or on behalf of, the 58 | Licensor for the purpose of discussing and improving the Work, but 59 | excluding communication that is conspicuously marked or otherwise 60 | designated in writing by the copyright owner as "Not a Contribution." 61 | 62 | "Contributor" shall mean Licensor and any individual or Legal Entity 63 | on behalf of whom a Contribution has been received by Licensor and 64 | subsequently incorporated within the Work. 65 | 66 | 2. Grant of Copyright License. Subject to the terms and conditions of 67 | this License, each Contributor hereby grants to You a perpetual, 68 | worldwide, non-exclusive, no-charge, royalty-free, irrevocable 69 | copyright license to reproduce, prepare Derivative Works of, 70 | publicly display, publicly perform, sublicense, and distribute the 71 | Work and such Derivative Works in Source or Object form. 72 | 73 | 3. Grant of Patent License. Subject to the terms and conditions of 74 | this License, each Contributor hereby grants to You a perpetual, 75 | worldwide, non-exclusive, no-charge, royalty-free, irrevocable 76 | (except as stated in this section) patent license to make, have made, 77 | use, offer to sell, sell, import, and otherwise transfer the Work, 78 | where such license applies only to those patent claims licensable 79 | by such Contributor that are necessarily infringed by their 80 | Contribution(s) alone or by combination of their Contribution(s) 81 | with the Work to which such Contribution(s) was submitted. If You 82 | institute patent litigation against any entity (including a 83 | cross-claim or counterclaim in a lawsuit) alleging that the Work 84 | or a Contribution incorporated within the Work constitutes direct 85 | or contributory patent infringement, then any patent licenses 86 | granted to You under this License for that Work shall terminate 87 | as of the date such litigation is filed. 88 | 89 | 4. Redistribution. You may reproduce and distribute copies of the 90 | Work or Derivative Works thereof in any medium, with or without 91 | modifications, and in Source or Object form, provided that You 92 | meet the following conditions: 93 | 94 | (a) You must give any other recipients of the Work or 95 | Derivative Works a copy of this License; and 96 | 97 | (b) You must cause any modified files to carry prominent notices 98 | stating that You changed the files; and 99 | 100 | (c) You must retain, in the Source form of any Derivative Works 101 | that You distribute, all copyright, patent, trademark, and 102 | attribution notices from the Source form of the Work, 103 | excluding those notices that do not pertain to any part of 104 | the Derivative Works; and 105 | 106 | (d) If the Work includes a "NOTICE" text file as part of its 107 | distribution, then any Derivative Works that You distribute must 108 | include a readable copy of the attribution notices contained 109 | within such NOTICE file, excluding those notices that do not 110 | pertain to any part of the Derivative Works, in at least one 111 | of the following places: within a NOTICE text file distributed 112 | as part of the Derivative Works; within the Source form or 113 | documentation, if provided along with the Derivative Works; or, 114 | within a display generated by the Derivative Works, if and 115 | wherever such third-party notices normally appear. The contents 116 | of the NOTICE file are for informational purposes only and 117 | do not modify the License. You may add Your own attribution 118 | notices within Derivative Works that You distribute, alongside 119 | or as an addendum to the NOTICE text from the Work, provided 120 | that such additional attribution notices cannot be construed 121 | as modifying the License. 122 | 123 | You may add Your own copyright statement to Your modifications and 124 | may provide additional or different license terms and conditions 125 | for use, reproduction, or distribution of Your modifications, or 126 | for any such Derivative Works as a whole, provided Your use, 127 | reproduction, and distribution of the Work otherwise complies with 128 | the conditions stated in this License. 129 | 130 | 5. Submission of Contributions. Unless You explicitly state otherwise, 131 | any Contribution intentionally submitted for inclusion in the Work 132 | by You to the Licensor shall be under the terms and conditions of 133 | this License, without any additional terms or conditions. 134 | Notwithstanding the above, nothing herein shall supersede or modify 135 | the terms of any separate license agreement you may have executed 136 | with Licensor regarding such Contributions. 137 | 138 | 6. Trademarks. This License does not grant permission to use the trade 139 | names, trademarks, service marks, or product names of the Licensor, 140 | except as required for reasonable and customary use in describing the 141 | origin of the Work and reproducing the content of the NOTICE file. 142 | 143 | 7. Disclaimer of Warranty. Unless required by applicable law or 144 | agreed to in writing, Licensor provides the Work (and each 145 | Contributor provides its Contributions) on an "AS IS" BASIS, 146 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or 147 | implied, including, without limitation, any warranties or conditions 148 | of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A 149 | PARTICULAR PURPOSE. You are solely responsible for determining the 150 | appropriateness of using or redistributing the Work and assume any 151 | risks associated with Your exercise of permissions under this License. 152 | 153 | 8. Limitation of Liability. In no event and under no legal theory, 154 | whether in tort (including negligence), contract, or otherwise, 155 | unless required by applicable law (such as deliberate and grossly 156 | negligent acts) or agreed to in writing, shall any Contributor be 157 | liable to You for damages, including any direct, indirect, special, 158 | incidental, or consequential damages of any character arising as a 159 | result of this License or out of the use or inability to use the 160 | Work (including but not limited to damages for loss of goodwill, 161 | work stoppage, computer failure or malfunction, or any and all 162 | other commercial damages or losses), even if such Contributor 163 | has been advised of the possibility of such damages. 164 | 165 | 9. Accepting Warranty or Additional Liability. While redistributing 166 | the Work or Derivative Works thereof, You may choose to offer, 167 | and charge a fee for, acceptance of support, warranty, indemnity, 168 | or other liability obligations and/or rights consistent with this 169 | License. However, in accepting such obligations, You may act only 170 | on Your own behalf and on Your sole responsibility, not on behalf 171 | of any other Contributor, and only if You agree to indemnify, 172 | defend, and hold each Contributor harmless for any liability 173 | incurred by, or claims asserted against, such Contributor by reason 174 | of your accepting any such warranty or additional liability. 175 | 176 | END OF TERMS AND CONDITIONS 177 | 178 | APPENDIX: How to apply the Apache License to your work. 179 | 180 | To apply the Apache License to your work, attach the following 181 | boilerplate notice, with the fields enclosed by brackets "{}" 182 | replaced with your own identifying information. (Don't include 183 | the brackets!) The text should be enclosed in the appropriate 184 | comment syntax for the file format. We also recommend that a 185 | file or class name and description of purpose be included on the 186 | same "printed page" as the copyright notice for easier 187 | identification within third-party archives. 188 | 189 | Copyright 2015 Asbjørn Heid 190 | 191 | Licensed under the Apache License, Version 2.0 (the "License"); 192 | you may not use this file except in compliance with the License. 193 | You may obtain a copy of the License at 194 | 195 | http://www.apache.org/licenses/LICENSE-2.0 196 | 197 | Unless required by applicable law or agreed to in writing, software 198 | distributed under the License is distributed on an "AS IS" BASIS, 199 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 200 | See the License for the specific language governing permissions and 201 | limitations under the License. 202 | 203 | -------------------------------------------------------------------------------- /Examples/HTTP/AsyncHttpServer.RequestParser.pas: -------------------------------------------------------------------------------- 1 | unit AsyncHttpServer.RequestParser; 2 | 3 | interface 4 | 5 | uses 6 | System.SysUtils, AsyncIO, AsyncHttpServer.Request; 7 | 8 | type 9 | HttpRequestState = ( 10 | HttpRequestStateNeedMoreData, 11 | HttpRequestStateValid, 12 | HttpRequestStateInvalid 13 | ); 14 | 15 | HttpRequestParser = interface 16 | ['{02575C91-D940-4399-B2AD-BE943B6A3DAB}'] 17 | 18 | function Parse(var Request: HttpRequest; const Buffer: StreamBuffer): HttpRequestState; 19 | 20 | function GetParsedData: TBytes; 21 | 22 | property ParsedData: TBytes read GetParsedData; 23 | end; 24 | 25 | function NewHttpRequestParser: HttpRequestParser; 26 | 27 | implementation 28 | 29 | uses 30 | System.Math, AsyncHttpServer.Headers; 31 | 32 | {$POINTERMATH ON} 33 | 34 | type 35 | Octet = UInt8; 36 | POctet = ^Octet; 37 | 38 | OctetHelper = record helper for Octet 39 | function IsChar: boolean; overload; 40 | function IsChar(const C: char): boolean; overload; 41 | function IsCtl: boolean; 42 | function IsDigit: boolean; 43 | function IsSP: boolean; 44 | function IsHT: boolean; 45 | function IsToken: boolean; 46 | function IsTSpecial: boolean; 47 | function IsCR: boolean; 48 | function IsLF: boolean; 49 | 50 | function AsDigit: UInt8; 51 | end; 52 | 53 | ParserState = ( 54 | RequestLineStart, 55 | Method, 56 | RequestURI, 57 | HTTPVersionH, 58 | HTTPVersionT1, 59 | HTTPVersionT2, 60 | HTTPVersionP, 61 | HTTPVersionSlash, 62 | HTTPVersionMajorStart, 63 | HTTPVersionMajorNext, 64 | HTTPVersionMinorStart, 65 | HTTPVersionMinorNext, 66 | RequestLineEnd, 67 | HeaderLineStart, 68 | HeaderLWS, 69 | HeaderName, 70 | HeaderNameValueSeparator, 71 | HeaderValue, 72 | HeaderLineEnd, 73 | RequestEnd, 74 | Done 75 | ); 76 | 77 | HttpRequestParserImpl = class(TInterfacedObject, HttpRequestParser) 78 | strict private 79 | FState: ParserState; 80 | FCharMapping: array[Octet] of char; 81 | FParsedData: TBytes; 82 | FCurHeader: HttpHeader; 83 | 84 | function OctetAsChar(const Input: Octet): char; 85 | 86 | procedure CreateCharMapping(const Encoding: TEncoding); 87 | 88 | function ProcessInput(var Request: HttpRequest; const Input: Octet): HttpRequestState; 89 | 90 | property State: ParserState read FState write FState; 91 | public 92 | constructor Create; 93 | 94 | function GetParsedData: TBytes; 95 | 96 | function Parse(var Request: HttpRequest; const Buffer: StreamBuffer): HttpRequestState; 97 | end; 98 | 99 | function NewHttpRequestParser: HttpRequestParser; 100 | begin 101 | result := HttpRequestParserImpl.Create; 102 | end; 103 | 104 | function OctetHelper.AsDigit: UInt8; 105 | begin 106 | result := (Self - Ord('0')); 107 | end; 108 | 109 | function OctetHelper.IsChar: boolean; 110 | begin 111 | result := (Self <= 127); 112 | end; 113 | 114 | function OctetHelper.IsChar(const C: char): boolean; 115 | begin 116 | result := IsChar() and (Self = Ord(C)); 117 | end; 118 | 119 | function OctetHelper.IsCR: boolean; 120 | begin 121 | result := (Self = 13); 122 | end; 123 | 124 | function OctetHelper.IsCtl: boolean; 125 | begin 126 | result := (Self <= 31) or (Self = 127); 127 | end; 128 | 129 | function OctetHelper.IsDigit: boolean; 130 | begin 131 | result := (Self >= Ord('0')) or (Self <= Ord('9')); 132 | end; 133 | 134 | function OctetHelper.IsHT: boolean; 135 | begin 136 | result := (Self = 9); 137 | end; 138 | 139 | function OctetHelper.IsLF: boolean; 140 | begin 141 | result := (Self = 10); 142 | end; 143 | 144 | function OctetHelper.IsSP: boolean; 145 | begin 146 | result := (Self = 32); 147 | end; 148 | 149 | function OctetHelper.IsToken: boolean; 150 | begin 151 | result := IsChar and (not IsCtl) and (not IsTSpecial); 152 | end; 153 | 154 | function OctetHelper.IsTSpecial: boolean; 155 | begin 156 | result := 157 | (Self.IsChar('(')) or 158 | (Self.IsChar(')')) or 159 | (Self.IsChar('<')) or 160 | (Self.IsChar('>')) or 161 | (Self.IsChar('@')) or 162 | (Self.IsChar(',')) or 163 | (Self.IsChar(';')) or 164 | (Self.IsChar(':')) or 165 | (Self.IsChar('\')) or 166 | (Self.IsChar('"')) or 167 | (Self.IsChar('/')) or 168 | (Self.IsChar('[')) or 169 | (Self.IsChar(']')) or 170 | (Self.IsChar('?')) or 171 | (Self.IsChar('=')) or 172 | (Self.IsChar('{')) or 173 | (Self.IsChar('}')) or 174 | IsSP or 175 | IsHT; 176 | end; 177 | 178 | { HttpRequestParserImpl } 179 | 180 | constructor HttpRequestParserImpl.Create; 181 | begin 182 | inherited Create; 183 | 184 | // HTTP standard says to use system encoding so we do... 185 | CreateCharMapping(TEncoding.Default); 186 | end; 187 | 188 | procedure HttpRequestParserImpl.CreateCharMapping(const Encoding: TEncoding); 189 | var 190 | input: Octet; 191 | b: TBytes; 192 | c: TArray; 193 | begin 194 | SetLength(b, 1); 195 | for input := Low(Octet) to High(Octet) do 196 | begin 197 | b[0] := input; 198 | 199 | c := Encoding.GetChars(b); 200 | 201 | if (Length(c) <> 1) then 202 | raise EArgumentException.Create('Encoding not compatible'); 203 | 204 | FCharMapping[input] := c[0]; 205 | end; 206 | end; 207 | 208 | function HttpRequestParserImpl.GetParsedData: TBytes; 209 | begin 210 | result := FParsedData; 211 | end; 212 | 213 | function HttpRequestParserImpl.OctetAsChar(const Input: Octet): char; 214 | begin 215 | result := FCharMapping[Input]; 216 | end; 217 | 218 | function HttpRequestParserImpl.Parse(var Request: HttpRequest; 219 | const Buffer: StreamBuffer): HttpRequestState; 220 | var 221 | i: UInt32; 222 | inputBuffer: MemoryBuffer; 223 | inputData: POctet; 224 | input: Octet; 225 | begin 226 | result := HttpRequestStateNeedMoreData; 227 | 228 | while (Buffer.BufferSize > 0) and (result = HttpRequestStateNeedMoreData) do 229 | begin 230 | // prepare consume a block from the buffer 231 | inputBuffer := Buffer.PrepareConsume(Min(Buffer.BufferSize, MaxInt)); 232 | 233 | inputData := inputBuffer.Data; 234 | i := 0; 235 | while (i < inputBuffer.Size) do 236 | begin 237 | input := inputData[i]; 238 | result := ProcessInput(Request, input); 239 | 240 | i := i + 1; 241 | 242 | if (result <> HttpRequestStateNeedMoreData) then 243 | break; 244 | end; 245 | 246 | Buffer.Consume(i); 247 | end; 248 | end; 249 | 250 | function HttpRequestParserImpl.ProcessInput(var Request: HttpRequest; 251 | const Input: Octet): HttpRequestState; 252 | begin 253 | Insert(Input, FParsedData, Length(FParsedData)); 254 | 255 | case State of 256 | RequestLineStart: begin 257 | if (Input.IsToken) then 258 | begin 259 | State := Method; 260 | Request.Method := OctetAsChar(Input); 261 | result := HttpRequestStateNeedMoreData; 262 | end 263 | else 264 | begin 265 | result := HttpRequestStateInvalid; 266 | end; 267 | end; 268 | 269 | Method: begin 270 | if (Input.IsSP) then 271 | begin 272 | Request.URI := ''; 273 | State := RequestURI; 274 | result := HttpRequestStateNeedMoreData; 275 | end 276 | else if (Input.IsToken) then 277 | begin 278 | Request.Method := Request.Method + OctetAsChar(Input); 279 | result := HttpRequestStateNeedMoreData; 280 | end 281 | else 282 | begin 283 | result := HttpRequestStateInvalid; 284 | end; 285 | end; 286 | 287 | RequestURI: begin 288 | if (Input.IsSP) then 289 | begin 290 | State := HTTPVersionH; 291 | result := HttpRequestStateNeedMoreData; 292 | end 293 | else if (not Input.IsCtl) then 294 | begin 295 | Request.URI := Request.URI + OctetAsChar(Input); 296 | result := HttpRequestStateNeedMoreData; 297 | end 298 | else 299 | begin 300 | result := HttpRequestStateInvalid; 301 | end; 302 | end; 303 | 304 | HTTPVersionH: begin 305 | if (Input.IsChar('H')) then 306 | begin 307 | State := HTTPVersionT1; 308 | result := HttpRequestStateNeedMoreData; 309 | end 310 | else 311 | begin 312 | result := HttpRequestStateInvalid; 313 | end; 314 | end; 315 | 316 | HTTPVersionT1: begin 317 | if (Input.IsChar('T')) then 318 | begin 319 | State := HTTPVersionT2; 320 | result := HttpRequestStateNeedMoreData; 321 | end 322 | else 323 | begin 324 | result := HttpRequestStateInvalid; 325 | end; 326 | end; 327 | 328 | HTTPVersionT2: begin 329 | if (Input.IsChar('T')) then 330 | begin 331 | State := HTTPVersionP; 332 | result := HttpRequestStateNeedMoreData; 333 | end 334 | else 335 | begin 336 | result := HttpRequestStateInvalid; 337 | end; 338 | end; 339 | 340 | HTTPVersionP: begin 341 | if (Input.IsChar('P')) then 342 | begin 343 | State := HTTPVersionSlash; 344 | result := HttpRequestStateNeedMoreData; 345 | end 346 | else 347 | begin 348 | result := HttpRequestStateInvalid; 349 | end; 350 | end; 351 | 352 | HTTPVersionSlash: begin 353 | if (Input.IsChar('/')) then 354 | begin 355 | State := HTTPVersionMajorStart; 356 | result := HttpRequestStateNeedMoreData; 357 | end 358 | else 359 | begin 360 | result := HttpRequestStateInvalid; 361 | end; 362 | end; 363 | 364 | HTTPVersionMajorStart: begin 365 | Request.HttpVersionMajor := 0; 366 | Request.HttpVersionMinor := 0; 367 | 368 | if (Input.IsDigit) then 369 | begin 370 | Request.HttpVersionMajor := (Request.HttpVersionMajor * 10) + Input.AsDigit; 371 | State := HTTPVersionMajorNext; 372 | result := HttpRequestStateNeedMoreData; 373 | end 374 | else 375 | begin 376 | result := HttpRequestStateInvalid; 377 | end; 378 | end; 379 | 380 | HTTPVersionMajorNext: begin 381 | if (Input.IsChar('.')) then 382 | begin 383 | State := HTTPVersionMinorStart; 384 | result := HttpRequestStateNeedMoreData; 385 | end 386 | else if (Input.IsDigit) then 387 | begin 388 | Request.HttpVersionMajor := (Request.HttpVersionMajor * 10) + Input.AsDigit; 389 | result := HttpRequestStateNeedMoreData; 390 | end 391 | else 392 | begin 393 | result := HttpRequestStateInvalid; 394 | end; 395 | end; 396 | 397 | HTTPVersionMinorStart: begin 398 | if (Input.IsDigit) then 399 | begin 400 | Request.HttpVersionMinor := (Request.HttpVersionMinor * 10) + Input.AsDigit; 401 | State := HTTPVersionMinorNext; 402 | result := HttpRequestStateNeedMoreData; 403 | end 404 | else 405 | begin 406 | result := HttpRequestStateInvalid; 407 | end; 408 | end; 409 | 410 | HTTPVersionMinorNext: begin 411 | if (Input.IsCR()) then 412 | begin 413 | State := RequestLineEnd; 414 | result := HttpRequestStateNeedMoreData; 415 | end 416 | else if (Input.IsDigit) then 417 | begin 418 | Request.HttpVersionMinor := (Request.HttpVersionMinor * 10) + Input.AsDigit; 419 | result := HttpRequestStateNeedMoreData; 420 | end 421 | else 422 | begin 423 | result := HttpRequestStateInvalid; 424 | end; 425 | end; 426 | 427 | RequestLineEnd: begin 428 | if (Input.IsLF) then 429 | begin 430 | State := HeaderLineStart; 431 | result := HttpRequestStateNeedMoreData; 432 | end 433 | else 434 | begin 435 | result := HttpRequestStateInvalid; 436 | end; 437 | end; 438 | 439 | HeaderLineStart: begin 440 | if (Input.IsCR) then 441 | begin 442 | Request.Headers.Append(FCurHeader); 443 | FCurHeader := EmptyHttpHeader(); 444 | State := RequestEnd; 445 | result := HttpRequestStateNeedMoreData; 446 | end 447 | else if ((not Request.Headers.IsEmpty) and (Input.IsSP or Input.IsHT)) then 448 | begin 449 | State := HeaderLWS; 450 | result := HttpRequestStateNeedMoreData; 451 | end 452 | else if (Input.IsToken) then 453 | begin 454 | Request.Headers.Append(FCurHeader); 455 | FCurHeader.Name := OctetAsChar(Input); 456 | FCurHeader.Value := ''; 457 | State := HeaderName; 458 | result := HttpRequestStateNeedMoreData; 459 | end 460 | else 461 | begin 462 | result := HttpRequestStateInvalid; 463 | end; 464 | end; 465 | 466 | HeaderLWS: begin 467 | if (Input.IsCR) then 468 | begin 469 | State := RequestLineEnd; 470 | result := HttpRequestStateNeedMoreData; 471 | end 472 | else if (Input.IsSP or Input.IsHT) then 473 | begin 474 | result := HttpRequestStateNeedMoreData; 475 | end 476 | else if (not Input.IsCtl) then 477 | begin 478 | FCurHeader.Value := FCurHeader.Value + OctetAsChar(Input); 479 | result := HttpRequestStateNeedMoreData; 480 | end 481 | else 482 | begin 483 | result := HttpRequestStateInvalid; 484 | end; 485 | end; 486 | 487 | HeaderName: begin 488 | if (Input.IsChar(':')) then 489 | begin 490 | State := HeaderNameValueSeparator; 491 | result := HttpRequestStateNeedMoreData; 492 | end 493 | else if (Input.IsToken) then 494 | begin 495 | FCurHeader.Name := FCurHeader.Name + OctetAsChar(Input); 496 | result := HttpRequestStateNeedMoreData; 497 | end 498 | else 499 | begin 500 | result := HttpRequestStateInvalid; 501 | end; 502 | end; 503 | 504 | HeaderNameValueSeparator: begin 505 | if (Input.IsSP) then 506 | begin 507 | State := HeaderValue; 508 | result := HttpRequestStateNeedMoreData; 509 | end 510 | else 511 | begin 512 | result := HttpRequestStateInvalid; 513 | end; 514 | end; 515 | 516 | HeaderValue: begin 517 | if (Input.IsCR) then 518 | begin 519 | State := HeaderLineEnd; 520 | result := HttpRequestStateNeedMoreData; 521 | end 522 | else if (not Input.IsCtl) then 523 | begin 524 | FCurHeader.Value := FCurHeader.Value + OctetAsChar(Input); 525 | result := HttpRequestStateNeedMoreData; 526 | end 527 | else 528 | begin 529 | result := HttpRequestStateInvalid; 530 | end; 531 | end; 532 | 533 | HeaderLineEnd: begin 534 | if (Input.IsLF) then 535 | begin 536 | State := HeaderLineStart; 537 | result := HttpRequestStateNeedMoreData; 538 | end 539 | else 540 | begin 541 | result := HttpRequestStateInvalid; 542 | end; 543 | end; 544 | 545 | RequestEnd: begin 546 | if (Input.IsLF) then 547 | begin 548 | State := Done; 549 | result := HttpRequestStateValid; 550 | end 551 | else 552 | begin 553 | result := HttpRequestStateInvalid; 554 | end; 555 | end; 556 | 557 | Done: begin 558 | raise EProgrammerNotFound.Create('HttpRequestParser.Parse called after parsing completed'); 559 | end; 560 | else 561 | raise EProgrammerNotFound.Create('HttpRequestParser in unknown parser state'); 562 | end; 563 | end; 564 | 565 | end. 566 | -------------------------------------------------------------------------------- /Examples/HTTP/AsyncHttpServer.Connection.pas: -------------------------------------------------------------------------------- 1 | unit AsyncHttpServer.Connection; 2 | 3 | interface 4 | 5 | uses 6 | System.SysUtils, AsyncIO, AsyncIO.Net.IP, AsyncHttpServer.Request, 7 | AsyncHttpServer.RequestHandler, AsyncHttpServer.Response; 8 | 9 | type 10 | HttpConnectionManager = interface; 11 | 12 | HttpConnection = interface 13 | ['{A7AC1C03-AE5C-4A4C-B49E-C591050176B0}'] 14 | {$REGION 'Property accessors'} 15 | function GetSocket: IPStreamSocket; 16 | function GetConnectionManager: HttpConnectionManager; 17 | function GetRequestHandler: HttpRequestHandler; 18 | {$ENDREGION} 19 | 20 | procedure Start; 21 | procedure Stop; 22 | 23 | property Socket: IPStreamSocket read GetSocket; 24 | property ConnectionManager: HttpConnectionManager read GetConnectionManager; 25 | property RequestHandler: HttpRequestHandler read GetRequestHandler; 26 | end; 27 | 28 | HttpConnectionManager = interface 29 | ['{4B05AE86-77DC-442C-8679-518353DFAB34}'] 30 | 31 | procedure StopAll; 32 | end; 33 | 34 | function NewHttpConnection(const Socket: IPStreamSocket; const ConnectionManager: HttpConnectionManager; const RequestHandler: HttpRequestHandler): HttpConnection; 35 | function NewHttpConnectionManager: HttpConnectionManager; 36 | 37 | procedure ManageHttpConnection(const Connection: HttpConnection; const ConnectionManager: HttpConnectionManager); 38 | procedure RemoveHttpConnection(const Connection: HttpConnection; const ConnectionManager: HttpConnectionManager); 39 | 40 | implementation 41 | 42 | uses 43 | System.Generics.Collections, AsyncIO.OpResults, 44 | AsyncHttpServer.RequestParser, AsyncHttpServer.Headers, HttpDateTime; 45 | 46 | type 47 | HttpConnectionImpl = class(TInterfacedObject, HttpConnection) 48 | public 49 | const MaxRequestSize = 16 * 1024 * 1024; // max request size 50 | const MaxContentBufferSize = 64 * 1024; // max buffer size when sending content 51 | strict private 52 | FSocket: IPStreamSocket; 53 | FStream: AsyncSocketStream; 54 | FConnectionManager: HttpConnectionManager; 55 | FRequestHandler: HttpRequestHandler; 56 | FRequestParser: HttpRequestParser; 57 | FBuffer: StreamBuffer; 58 | FContentBuffer: TBytes; 59 | FRequest: HttpRequest; 60 | FResponse: HttpResponse; 61 | 62 | procedure Log(const Msg: string); 63 | 64 | procedure DoReadRequest; 65 | 66 | procedure DoParseRequest; 67 | 68 | procedure DoReadResponseContent; 69 | 70 | procedure DoWriteResponse; 71 | 72 | procedure StartWriteResponseContent; 73 | 74 | procedure DoStartConnection; 75 | 76 | procedure DoShutdownConnection; 77 | procedure DoStopConnection; 78 | 79 | procedure HandleRequest; 80 | procedure HandleInvalidRequest; 81 | 82 | procedure ReadRequestHandler(const Res: OpResult; const BytesTransferred: UInt64); 83 | procedure WriteResponseHandler(const Res: OpResult; const BytesTransferred: UInt64); 84 | 85 | procedure ReadResponseContentHandler(const Res: OpResult; const BytesTransferred: UInt64); 86 | procedure WriteResponseContentHandler(const Res: OpResult; const BytesTransferred: UInt64); 87 | public 88 | constructor Create(const Socket: IPStreamSocket; const ConnectionManager: HttpConnectionManager; const RequestHandler: HttpRequestHandler; const RequestParser: HttpRequestParser); 89 | 90 | function GetSocket: IPStreamSocket; 91 | function GetConnectionManager: HttpConnectionManager; 92 | function GetRequestHandler: HttpRequestHandler; 93 | 94 | procedure Start; 95 | procedure Stop; 96 | 97 | property Socket: IPStreamSocket read FSocket; 98 | property ConnectionManager: HttpConnectionManager read FConnectionManager; 99 | property RequestHandler: HttpRequestHandler read FRequestHandler; 100 | property RequestParser: HttpRequestParser read FRequestParser; 101 | end; 102 | 103 | function NewHttpConnection(const Socket: IPStreamSocket; const ConnectionManager: HttpConnectionManager; const RequestHandler: HttpRequestHandler): HttpConnection; 104 | var 105 | requestParser: HttpRequestParser; 106 | begin 107 | requestParser := NewHttpRequestParser(); 108 | result := HttpConnectionImpl.Create(Socket, ConnectionManager, RequestHandler, requestParser); 109 | end; 110 | 111 | { HttpConnectionImpl } 112 | 113 | constructor HttpConnectionImpl.Create(const Socket: IPStreamSocket; 114 | const ConnectionManager: HttpConnectionManager; 115 | const RequestHandler: HttpRequestHandler; 116 | const RequestParser: HttpRequestParser); 117 | begin 118 | inherited Create; 119 | 120 | FSocket := Socket; 121 | FConnectionManager := ConnectionManager; 122 | FRequestHandler := RequestHandler; 123 | FRequestParser := RequestParser; 124 | end; 125 | 126 | procedure HttpConnectionImpl.DoParseRequest; 127 | var 128 | reqStatus: HttpRequestState; 129 | begin 130 | // any read data has been appended to our buffer 131 | // so pass it to the parser 132 | reqStatus := RequestParser.Parse(FRequest, FBuffer); 133 | 134 | case reqStatus of 135 | HttpRequestStateValid: begin 136 | // we got a valid request, time to handle it 137 | HandleRequest; 138 | end; 139 | HttpRequestStateNeedMoreData: begin 140 | // haven't got entire request yet, so queue another read 141 | DoReadRequest; 142 | end; 143 | else 144 | // request was bad, send an error response 145 | HandleInvalidRequest; 146 | end; 147 | end; 148 | 149 | procedure HttpConnectionImpl.DoReadRequest; 150 | begin 151 | AsyncRead(FStream, FBuffer, TransferAtLeast(1), ReadRequestHandler); 152 | end; 153 | 154 | procedure HttpConnectionImpl.DoReadResponseContent; 155 | begin 156 | AsyncRead(FResponse.ContentStream, FContentBuffer, TransferAtLeast(1), ReadResponseContentHandler); 157 | end; 158 | 159 | procedure HttpConnectionImpl.DoShutdownConnection; 160 | begin 161 | FStream.Socket.Shutdown(); 162 | DoStopConnection; 163 | end; 164 | 165 | procedure HttpConnectionImpl.DoStartConnection; 166 | var 167 | con: HttpConnection; 168 | begin 169 | con := Self; 170 | ManageHttpConnection(con, ConnectionManager); 171 | end; 172 | 173 | procedure HttpConnectionImpl.DoStopConnection; 174 | var 175 | con: HttpConnection; 176 | begin 177 | con := Self; 178 | // socket has been closed 179 | RemoveHttpConnection(con, ConnectionManager); 180 | end; 181 | 182 | procedure HttpConnectionImpl.DoWriteResponse; 183 | begin 184 | // start sending the response we got 185 | FBuffer := FResponse.ToBuffer(); 186 | 187 | AsyncWrite(FStream, FBuffer, TransferAll(), WriteResponseHandler); 188 | end; 189 | 190 | function HttpConnectionImpl.GetConnectionManager: HttpConnectionManager; 191 | begin 192 | result := FConnectionManager; 193 | end; 194 | 195 | function HttpConnectionImpl.GetRequestHandler: HttpRequestHandler; 196 | begin 197 | result := FRequestHandler; 198 | end; 199 | 200 | function HttpConnectionImpl.GetSocket: IPStreamSocket; 201 | begin 202 | result := FSocket; 203 | end; 204 | 205 | procedure HttpConnectionImpl.HandleInvalidRequest; 206 | begin 207 | FResponse := StandardResponse(StatusBadRequest); 208 | DoWriteResponse; 209 | end; 210 | 211 | procedure HttpConnectionImpl.HandleRequest; 212 | begin 213 | // we've got a valid request, we need to handle it and send the response 214 | 215 | {$IFDEF DEBUG_LOG} 216 | {$IFDEF LOG_DETAILED} 217 | Log(Format(#13#10 + ' %s %s HTTP/%d.%d', [FRequest.Method, FRequest.URI, FRequest.HttpVersionMajor, FRequest.HttpVersionMinor]) + FRequest.Headers.ToDebugString()); 218 | {$ELSE} 219 | Log(FRequest.Method + ' ' + FRequest.URI + ' HTTP/' + FRequest.HttpVersionMajor.ToString() + '.' + FRequest.HttpVersionMinor.ToString()); 220 | {$ENDIF} 221 | {$ENDIF} 222 | 223 | try 224 | // get the response from our request handler 225 | FResponse := RequestHandler.HandleRequest(FRequest); 226 | 227 | {$IFDEF DEBUG_LOG} 228 | {$IFDEF LOG_DETAILED} 229 | Log(Format(#13#10 + ' %d %s', [Ord(FResponse.Status), FResponse.Status.ToString()]) + FResponse.Headers.ToDebugString()); 230 | {$ELSE} 231 | Log(Ord(FResponse.Status).ToString() + ' ' + FResponse.Status.ToString()); 232 | {$ENDIF} 233 | {$ENDIF} 234 | except 235 | on E: Exception do 236 | begin 237 | // something went wrong, get an error response 238 | Log(Format('Error processing request (%s %s HTTP/%d.%d): [%s] %s', [FRequest.Method, FRequest.URI, FRequest.HttpVersionMajor, FRequest.HttpVersionMinor, E.ClassName, E.Message])); 239 | FResponse := StandardResponse(StatusInternalServerError); 240 | end; 241 | end; 242 | 243 | FResponse.Headers.Value['Date'] := SystemTimeToHttpDate(CurrentSystemTime()); 244 | FResponse.Headers.Value['Server'] := 'AsyncHttpServer'; 245 | 246 | // send whatever response we got 247 | DoWriteResponse; 248 | end; 249 | 250 | procedure HttpConnectionImpl.Log(const Msg: string); 251 | begin 252 | WriteLn('[' + FormatDateTime('yyyy.mm.dd hh:nn:ss.zzz', Now()) + '] ' + FSocket.RemoteEndpoint + ' | ' + Msg); 253 | end; 254 | 255 | procedure HttpConnectionImpl.ReadRequestHandler(const Res: OpResult; 256 | const BytesTransferred: UInt64); 257 | begin 258 | if ((Res.Success) and (BytesTransferred > 0)) then 259 | begin 260 | // we got at least some data forming the request, parse it and handle response if possible 261 | DoParseRequest(); 262 | end 263 | else if ((Res = NetResults.OperationAborted) or (BytesTransferred = 0)) then 264 | begin 265 | // socket has been closed or shut down 266 | DoStopConnection; 267 | end; 268 | // ingore other errors 269 | end; 270 | 271 | procedure HttpConnectionImpl.ReadResponseContentHandler( 272 | const Res: OpResult; const BytesTransferred: UInt64); 273 | begin 274 | if ((Res.Success) or (Res = SystemResults.EndOfFile)) then 275 | begin 276 | if (BytesTransferred > 0) then 277 | begin 278 | // we got some data from the response content stream 279 | // so send it to the client 280 | AsyncWrite(FStream, MakeBuffer(FContentBuffer, BytesTransferred), TransferAll(), WriteResponseContentHandler); 281 | end 282 | else 283 | begin 284 | // nothing more to read, so shut down connection 285 | DoShutdownConnection; 286 | end; 287 | end 288 | else 289 | begin 290 | // something went wrong, so kill connection 291 | DoStopConnection; 292 | end; 293 | end; 294 | 295 | procedure HttpConnectionImpl.Start; 296 | begin 297 | FBuffer := StreamBuffer.Create(MaxRequestSize); 298 | 299 | FStream := NewAsyncSocketStream(Socket); 300 | 301 | FRequest := NewHttpRequest; 302 | 303 | DoStartConnection; 304 | 305 | // we're all good to go, start by reading the request 306 | DoReadRequest; 307 | end; 308 | 309 | procedure HttpConnectionImpl.StartWriteResponseContent; 310 | begin 311 | if (not Assigned(FResponse.ContentStream)) then 312 | exit; 313 | 314 | FBuffer := nil; 315 | FContentBuffer := nil; 316 | SetLength(FContentBuffer, MaxContentBufferSize); 317 | 318 | // start by reading from the response content stream 319 | DoReadResponseContent; 320 | end; 321 | 322 | procedure HttpConnectionImpl.Stop; 323 | begin 324 | FSocket.Close; 325 | end; 326 | 327 | procedure HttpConnectionImpl.WriteResponseContentHandler( 328 | const Res: OpResult; const BytesTransferred: UInt64); 329 | var 330 | con: HttpConnection; 331 | begin 332 | if (Res.Success) then 333 | begin 334 | // response content stream data has been sent, so try reading some more 335 | DoReadResponseContent; 336 | end 337 | else 338 | begin 339 | FSocket.Shutdown(SocketShutdownBoth); 340 | 341 | if (Res = NetResults.OperationAborted) then 342 | begin 343 | con := Self; 344 | RemoveHttpConnection(con, ConnectionManager); 345 | end; 346 | end; 347 | end; 348 | 349 | procedure HttpConnectionImpl.WriteResponseHandler(const Res: OpResult; 350 | const BytesTransferred: UInt64); 351 | begin 352 | if (Res.Success) then 353 | begin 354 | // response has been sent, send response content stream if applicable 355 | StartWriteResponseContent; 356 | end 357 | else 358 | begin 359 | FSocket.Shutdown(SocketShutdownBoth); 360 | 361 | if (Res = NetResults.OperationAborted) then 362 | begin 363 | DoStopConnection; 364 | end; 365 | end; 366 | end; 367 | 368 | type 369 | THttpConnectionSet = class 370 | strict private 371 | FDict: TDictionary; 372 | public 373 | constructor Create; 374 | destructor Destroy; override; 375 | 376 | procedure Add(const Connection: HttpConnection); 377 | procedure Remove(const Connection: HttpConnection); 378 | 379 | function GetEnumerator: TEnumerator; 380 | end; 381 | 382 | { THttpConnectionSet } 383 | 384 | procedure THttpConnectionSet.Add(const Connection: HttpConnection); 385 | begin 386 | FDict.Add(Connection, 1); 387 | end; 388 | 389 | constructor THttpConnectionSet.Create; 390 | begin 391 | inherited Create; 392 | 393 | FDict := TDictionary.Create; 394 | end; 395 | 396 | destructor THttpConnectionSet.Destroy; 397 | begin 398 | FDict.Free; 399 | 400 | inherited; 401 | end; 402 | 403 | function THttpConnectionSet.GetEnumerator: TEnumerator; 404 | begin 405 | result := FDict.Keys.GetEnumerator(); 406 | end; 407 | 408 | procedure THttpConnectionSet.Remove(const Connection: HttpConnection); 409 | var 410 | hasConnection: boolean; 411 | begin 412 | hasConnection := FDict.ContainsKey(Connection); 413 | 414 | if (not hasConnection) then 415 | exit; 416 | 417 | FDict.Remove(Connection); 418 | end; 419 | 420 | type 421 | HttpConnectionManagerAssociation = interface 422 | ['{7E5B70C1-A9AD-463F-BDED-7EB0C6DFD854}'] 423 | 424 | procedure Manage(const Connection: HttpConnection); 425 | procedure Remove(const Connection: HttpConnection); 426 | end; 427 | 428 | HttpConnectionManagerImpl = class(TInterfacedObject, HttpConnectionManager, HttpConnectionManagerAssociation) 429 | strict private 430 | FConnections: THttpConnectionSet; 431 | 432 | property Connections: THttpConnectionSet read FConnections; 433 | public 434 | constructor Create; 435 | destructor Destroy; override; 436 | 437 | procedure Manage(const Connection: HttpConnection); 438 | procedure Remove(const Connection: HttpConnection); 439 | 440 | procedure StopAll; 441 | end; 442 | 443 | function NewHttpConnectionManager: HttpConnectionManager; 444 | begin 445 | result := HttpConnectionManagerImpl.Create; 446 | end; 447 | 448 | procedure ManageHttpConnection(const Connection: HttpConnection; const ConnectionManager: HttpConnectionManager); 449 | var 450 | assoc: HttpConnectionManagerAssociation; 451 | begin 452 | assoc := ConnectionManager as HttpConnectionManagerAssociation; 453 | assoc.Manage(Connection); 454 | end; 455 | 456 | procedure RemoveHttpConnection(const Connection: HttpConnection; const ConnectionManager: HttpConnectionManager); 457 | var 458 | assoc: HttpConnectionManagerAssociation; 459 | begin 460 | assoc := ConnectionManager as HttpConnectionManagerAssociation; 461 | assoc.Remove(Connection); 462 | end; 463 | 464 | { HttpConnectionManagerImpl } 465 | 466 | constructor HttpConnectionManagerImpl.Create; 467 | begin 468 | inherited Create; 469 | 470 | FConnections := THttpConnectionSet.Create; 471 | end; 472 | 473 | destructor HttpConnectionManagerImpl.Destroy; 474 | begin 475 | StopAll; 476 | 477 | FConnections.Free; 478 | 479 | inherited; 480 | end; 481 | 482 | procedure HttpConnectionManagerImpl.Manage(const Connection: HttpConnection); 483 | begin 484 | FConnections.Add(Connection); 485 | end; 486 | 487 | procedure HttpConnectionManagerImpl.Remove(const Connection: HttpConnection); 488 | begin 489 | FConnections.Remove(Connection); 490 | end; 491 | 492 | procedure HttpConnectionManagerImpl.StopAll; 493 | var 494 | con: HttpConnection; 495 | begin 496 | for con in Connections do 497 | begin 498 | con.Stop; 499 | Remove(con); 500 | end; 501 | end; 502 | 503 | end. 504 | -------------------------------------------------------------------------------- /Test/Test.AsyncIO.Net.IP.Detail.TCPImpl.pas: -------------------------------------------------------------------------------- 1 | unit Test.AsyncIO.Net.IP.Detail.TCPImpl; 2 | { 3 | 4 | Delphi DUnit Test Case 5 | ---------------------- 6 | This unit contains a skeleton test case class generated by the Test Case Wizard. 7 | Modify the generated code to correctly setup and call the methods from the unit 8 | being tested. 9 | 10 | } 11 | 12 | interface 13 | 14 | uses 15 | TestFramework, AsyncIO.Net.IP.Detail.TCPImpl, AsyncIO.Net.IP, IdWinsock2, AsyncIO, NetTestCase, 16 | EchoTestServer, EchoTestClient; 17 | 18 | type 19 | // Test methods for class TTCPSocketImpl 20 | 21 | TestTTCPSocketImpl = class(TNetTestCase) 22 | strict private 23 | FTestServer: IEchoTestServer; 24 | FService: IOService; 25 | FTCPSocketImpl: IPStreamSocket; 26 | public 27 | procedure SetUp; override; 28 | procedure TearDown; override; 29 | published 30 | procedure TestGetService; 31 | procedure TestGetProtocol; 32 | procedure TestGetProtocolIPv4; 33 | procedure TestGetProtocolIPv6; 34 | procedure TestGetLocalEndpoint; 35 | procedure TestGetRemoteEndpoint; 36 | procedure TestGetSocketHandle; 37 | procedure TestAsyncConnect; 38 | procedure TestBind; 39 | procedure TestConnect; 40 | procedure TestClose; 41 | procedure TestShutdown; 42 | procedure TestAsyncSend; 43 | procedure TestAsyncReceive; 44 | end; 45 | // Test methods for class TTCPAcceptorImpl 46 | 47 | TestTTCPAcceptorImpl = class(TNetTestCase) 48 | strict private 49 | FTestClient: IEchoTestClient; 50 | FService: IOService; 51 | public 52 | procedure SetUp; override; 53 | procedure TearDown; override; 54 | published 55 | procedure TestGetService; 56 | procedure TestGetProtocol; 57 | procedure TestGetLocalEndpoint; 58 | procedure TestGetIsOpen; 59 | procedure TestAsyncAccept; 60 | procedure TestOpen; 61 | procedure TestBind; 62 | procedure TestListen; 63 | procedure TestClose; 64 | end; 65 | 66 | implementation 67 | 68 | uses 69 | System.SysUtils, AsyncIO.OpResults, System.Threading, IdStack; 70 | 71 | procedure TestTTCPSocketImpl.SetUp; 72 | begin 73 | FTestServer := NewEchoTestServer(7); 74 | FService := NewIOService(); 75 | FTCPSocketImpl := NewTCPSocket(FService); 76 | end; 77 | 78 | procedure TestTTCPSocketImpl.TearDown; 79 | begin 80 | FTCPSocketImpl := nil; 81 | FService := nil; 82 | FTestServer := nil; 83 | end; 84 | 85 | procedure TestTTCPSocketImpl.TestGetService; 86 | var 87 | ReturnValue: IOService; 88 | begin 89 | ReturnValue := FTCPSocketImpl.GetService; 90 | CheckSame(FService, ReturnValue); 91 | end; 92 | 93 | procedure TestTTCPSocketImpl.TestGetSocketHandle; 94 | begin 95 | // TODO 96 | end; 97 | 98 | procedure TestTTCPSocketImpl.TestGetProtocol; 99 | var 100 | ReturnValue: IPProtocol; 101 | begin 102 | ReturnValue := FTCPSocketImpl.GetProtocol; 103 | 104 | CheckEquals(IPProtocol.TCP.Unspecified, ReturnValue); 105 | end; 106 | 107 | procedure TestTTCPSocketImpl.TestGetProtocolIPv4; 108 | var 109 | ReturnValue: IPProtocol; 110 | begin 111 | FTCPSocketImpl.Bind(Endpoint(IPAddressFamily.v4, 0)); 112 | 113 | ReturnValue := FTCPSocketImpl.GetProtocol; 114 | 115 | CheckEquals(IPProtocol.TCP.v4, ReturnValue); 116 | end; 117 | 118 | procedure TestTTCPSocketImpl.TestGetProtocolIPv6; 119 | var 120 | ReturnValue: IPProtocol; 121 | begin 122 | FTCPSocketImpl.Bind(Endpoint(IPAddressFamily.v6, 0)); 123 | 124 | ReturnValue := FTCPSocketImpl.GetProtocol; 125 | 126 | CheckEquals(IPProtocol.TCP.v6, ReturnValue); 127 | end; 128 | 129 | procedure TestTTCPSocketImpl.TestGetLocalEndpoint; 130 | var 131 | ReturnValue: IPEndpoint; 132 | begin 133 | try 134 | ReturnValue := FTCPSocketImpl.GetLocalEndpoint; 135 | except 136 | on E: Exception do CheckIs(E, EOSError, 'Failed to raise OS error for unbound socket'); 137 | end; 138 | 139 | FTCPSocketImpl.Bind(Endpoint(IPv4Address.Loopback, 0)); 140 | 141 | ReturnValue := FTCPSocketImpl.GetLocalEndpoint; 142 | 143 | CheckEquals(IPv4Address.Loopback, ReturnValue.Address, 'Failed to get local endpoint'); 144 | end; 145 | 146 | procedure TestTTCPSocketImpl.TestGetRemoteEndpoint; 147 | var 148 | PeerEndpoint: IPEndpoint; 149 | ReturnValue: IPEndpoint; 150 | begin 151 | FTestServer.Start; 152 | 153 | PeerEndpoint := Endpoint(IPv4Address.Loopback, FTestServer.Port); 154 | 155 | FTCPSocketImpl.Connect(PeerEndpoint); 156 | 157 | ReturnValue := FTCPSocketImpl.GetRemoteEndpoint; 158 | 159 | CheckEquals(PeerEndpoint, ReturnValue); 160 | end; 161 | 162 | procedure TestTTCPSocketImpl.TestAsyncConnect; 163 | var 164 | Handler: OpHandler; 165 | PeerEndpoint: IPEndpoint; 166 | HandlerExecuted: boolean; 167 | begin 168 | FTestServer.Start; 169 | 170 | PeerEndpoint := Endpoint(IPv4Address.Loopback, FTestServer.Port); 171 | 172 | HandlerExecuted := False; 173 | Handler := 174 | procedure(const Res: OpResult) 175 | begin 176 | HandlerExecuted := True; 177 | CheckEquals(SystemResults.Success, Res, 'AsyncConnect failed'); 178 | CheckEquals(PeerEndpoint, FTCPSocketImpl.RemoteEndpoint, 'Wrong remote endpoint'); 179 | end; 180 | 181 | FTCPSocketImpl.AsyncConnect(PeerEndpoint, Handler); 182 | 183 | FService.Poll; 184 | 185 | CheckTrue(HandlerExecuted, 'Failed to execute connect handler'); 186 | end; 187 | 188 | procedure TestTTCPSocketImpl.TestBind; 189 | var 190 | LocalEndpoint: IPEndpoint; 191 | begin 192 | LocalEndpoint := Endpoint(IPAddressFamily.v4, 0); 193 | 194 | FTCPSocketImpl.Bind(LocalEndpoint); 195 | 196 | CheckEquals(IPProtocol.TCP.v4, FTCPSocketImpl.GetProtocol); 197 | 198 | StartExpectingException(EOSError); 199 | 200 | LocalEndpoint := Endpoint(IPAddressFamily.v6, 0); 201 | 202 | FTCPSocketImpl.Bind(LocalEndpoint); 203 | 204 | StopExpectingException('Failed to raise error on double-bind'); 205 | end; 206 | 207 | procedure TestTTCPSocketImpl.TestConnect; 208 | var 209 | PeerEndpoint: IPEndpoint; 210 | ReturnValue: IPEndpoint; 211 | begin 212 | FTestServer.Start; 213 | 214 | PeerEndpoint := Endpoint(IPv4Address.Loopback, FTestServer.Port); 215 | 216 | FTCPSocketImpl.Connect(PeerEndpoint); 217 | 218 | CheckEquals(PeerEndpoint, FTCPSocketImpl.RemoteEndpoint); 219 | 220 | StartExpectingException(EOSError); 221 | 222 | PeerEndpoint := Endpoint(IPv6Address.Loopback, FTestServer.Port); 223 | FTCPSocketImpl.Connect(PeerEndpoint); 224 | 225 | StopExpectingException('Failed to raise error on double-connect'); 226 | end; 227 | 228 | procedure TestTTCPSocketImpl.TestClose; 229 | var 230 | PeerEndpoint: IPEndpoint; 231 | ReturnValue: IPEndpoint; 232 | begin 233 | FTestServer.Start; 234 | 235 | PeerEndpoint := Endpoint(IPv4Address.Loopback, FTestServer.Port); 236 | 237 | FTCPSocketImpl.Connect(PeerEndpoint); 238 | 239 | FTCPSocketImpl.Close; 240 | 241 | PeerEndpoint := Endpoint(IPv4Address.Loopback, FTestServer.Port); 242 | FTCPSocketImpl.Connect(PeerEndpoint); 243 | 244 | CheckEquals(PeerEndpoint, FTCPSocketImpl.RemoteEndpoint); 245 | end; 246 | 247 | procedure TestTTCPSocketImpl.TestShutdown; 248 | var 249 | PeerEndpoint: IPEndpoint; 250 | ShutdownFlag: SocketShutdownFlag; 251 | Data: TBytes; 252 | Handler: IOHandler; 253 | HandlerExecuted: boolean; 254 | begin 255 | SetLength(Data, 42); 256 | 257 | FTestServer.Start; 258 | 259 | PeerEndpoint := Endpoint(IPv4Address.Loopback, FTestServer.Port); 260 | 261 | FTCPSocketImpl.Connect(PeerEndpoint); 262 | 263 | 264 | FTCPSocketImpl.Shutdown(SocketShutdownWrite); 265 | 266 | HandlerExecuted := False; 267 | Handler := 268 | procedure(const Res: OpResult; const BytesTransferred: UInt64) 269 | begin 270 | HandlerExecuted := True; 271 | end; 272 | 273 | try 274 | FTCPSocketImpl.AsyncSend(Data, Handler); 275 | except 276 | on E: Exception do CheckIs(E, EOSError, 'Failed to shutdown write 1'); 277 | end; 278 | 279 | FService.Poll; 280 | 281 | CheckFalse(HandlerExecuted, 'Failed to shutdown write 2'); 282 | 283 | 284 | FTCPSocketImpl.Shutdown(SocketShutdownRead); 285 | 286 | HandlerExecuted := False; 287 | Handler := 288 | procedure(const Res: OpResult; const BytesTransferred: UInt64) 289 | begin 290 | HandlerExecuted := True; 291 | end; 292 | 293 | 294 | try 295 | FTCPSocketImpl.AsyncReceive(Data, Handler); 296 | except 297 | on E: Exception do CheckIs(E, EOSError, 'Failed to shutdown read 1'); 298 | end; 299 | 300 | FService.Poll; 301 | 302 | CheckFalse(HandlerExecuted, 'Failed to shutdown read 2'); 303 | end; 304 | 305 | procedure TestTTCPSocketImpl.TestAsyncSend; 306 | var 307 | Data: TBytes; 308 | PeerEndpoint: IPEndpoint; 309 | Handler: IOHandler; 310 | Buffer: MemoryBuffer; 311 | HandlerExecuted: boolean; 312 | begin 313 | SetLength(Data, 42); 314 | 315 | FTestServer.Start; 316 | 317 | PeerEndpoint := Endpoint(IPv4Address.Loopback, FTestServer.Port); 318 | 319 | FTCPSocketImpl.Connect(PeerEndpoint); 320 | 321 | HandlerExecuted := False; 322 | Handler := 323 | procedure(const Res: OpResult; const BytesTransferred: UInt64) 324 | begin 325 | HandlerExecuted := True; 326 | CheckEquals(SystemResults.Success, Res, 'Failed to write data'); 327 | CheckEquals(Length(Data), BytesTransferred, 'Failed to write all data'); 328 | end; 329 | 330 | FTCPSocketImpl.AsyncSend(Data, Handler); 331 | 332 | FService.RunOne; 333 | 334 | CheckTrue(HandlerExecuted, 'Failed to execute write handler'); 335 | end; 336 | 337 | procedure TestTTCPSocketImpl.TestAsyncReceive; 338 | var 339 | SrcData: TBytes; 340 | RecvData: TBytes; 341 | PeerEndpoint: IPEndpoint; 342 | Handler: IOHandler; 343 | Buffer: MemoryBuffer; 344 | HandlerExecuted: boolean; 345 | begin 346 | SrcData := GenerateData(42); 347 | 348 | FTestServer.Start; 349 | 350 | PeerEndpoint := Endpoint(IPv4Address.Loopback, FTestServer.Port); 351 | 352 | FTCPSocketImpl.Connect(PeerEndpoint); 353 | 354 | HandlerExecuted := False; 355 | Handler := 356 | procedure(const Res: OpResult; const BytesTransferred: UInt64) 357 | begin 358 | HandlerExecuted := True; 359 | CheckEquals(SystemResults.Success, Res, 'Failed to write data'); 360 | CheckEquals(Length(SrcData), BytesTransferred, 'Failed to write all data'); 361 | end; 362 | 363 | FTCPSocketImpl.AsyncSend(SrcData, Handler); 364 | 365 | FService.RunOne; 366 | 367 | CheckTrue(HandlerExecuted, 'Failed to execute write handler'); 368 | 369 | SetLength(RecvData, Length(SrcData)); 370 | 371 | // now do actual receive test 372 | HandlerExecuted := False; 373 | Handler := 374 | procedure(const Res: OpResult; const BytesTransferred: UInt64) 375 | begin 376 | HandlerExecuted := True; 377 | CheckEquals(SystemResults.Success, Res, 'Failed to read data'); 378 | CheckEquals(Length(RecvData), BytesTransferred, 'Failed to read all data'); 379 | end; 380 | 381 | FTCPSocketImpl.AsyncReceive(RecvData, Handler); 382 | 383 | FService.RunOne; 384 | 385 | CheckTrue(HandlerExecuted, 'Failed to execute read handler'); 386 | 387 | CheckEqualsMem(SrcData, RecvData, Length(SrcData), 'Read data does not match written data'); 388 | end; 389 | 390 | { TestTTCPAcceptorImpl } 391 | 392 | procedure TestTTCPAcceptorImpl.SetUp; 393 | begin 394 | FTestClient := NewEchoTestClient('::1', 7); 395 | FService := NewIOService(); 396 | end; 397 | 398 | procedure TestTTCPAcceptorImpl.TearDown; 399 | begin 400 | FTestClient := nil; 401 | FService := nil; 402 | end; 403 | 404 | procedure TestTTCPAcceptorImpl.TestAsyncAccept; 405 | var 406 | Data: string; 407 | TCPAcceptorImpl: IPAcceptor; 408 | PeerSocket: IPSocket; 409 | Handler: OpHandler; 410 | ReturnValue: IFuture; 411 | HandlerExecuted: boolean; 412 | begin 413 | Data := 'This is a test string'; 414 | 415 | TCPAcceptorImpl := NewTCPAcceptor(FService, Endpoint(IPProtocol.TCP.v6, 7)); 416 | 417 | PeerSocket := NewTCPSocket(FService); 418 | 419 | HandlerExecuted := False; 420 | Handler := 421 | procedure(const Res: OpResult) 422 | begin 423 | HandlerExecuted := True; 424 | CheckEquals(SystemResults.Success, Res, 'Failed to accept connection'); 425 | PeerSocket.Close; 426 | end; 427 | 428 | TCPAcceptorImpl.AsyncAccept(PeerSocket, Handler); 429 | 430 | ReturnValue := FTestClient.ConnectAndSend(Data); 431 | 432 | FService.RunOne; 433 | 434 | try 435 | ReturnValue.Wait(5000); 436 | Fail('Client failed to error on socket being closed during sending'); 437 | except 438 | on E: Exception do 439 | Check((E is EAggregateException) 440 | and (EAggregateException(E).InnerExceptions[0] is EIdSocketError) 441 | and (EIdSocketError(EAggregateException(E).InnerExceptions[0]).LastError = 10054), 'Error while connecting client'); 442 | end; 443 | 444 | CheckTrue(HandlerExecuted, 'Failed to execute accept handler'); 445 | end; 446 | 447 | procedure TestTTCPAcceptorImpl.TestBind; 448 | var 449 | Endp: IPEndpoint; 450 | TCPAcceptorImpl: IPAcceptor; 451 | TCPSocket: IPSocket; 452 | begin 453 | Endp := Endpoint(IPProtocol.TCP.v6, 7); 454 | 455 | TCPAcceptorImpl := NewTCPAcceptor(FService); 456 | TCPAcceptorImpl.Open(Endp.Protocol); 457 | TCPAcceptorImpl.Bind(Endp); 458 | 459 | TCPSocket := NewTCPSocket(FService); 460 | try 461 | TCPSocket.Bind(Endp); 462 | Fail('Binding socket to same endpoint as acceptor failed to raise exception'); 463 | except 464 | on E: Exception do CheckIs(E, EOSError, 'Binding socket to same endpoint as acceptor failed to raise OS error'); 465 | end; 466 | end; 467 | 468 | procedure TestTTCPAcceptorImpl.TestClose; 469 | var 470 | Endp: IPEndpoint; 471 | TCPAcceptorImpl: IPAcceptor; 472 | begin 473 | Endp := Endpoint(IPAddressFamily.v6, 7); 474 | 475 | TCPAcceptorImpl := NewTCPAcceptor(FService, Endp); 476 | 477 | CheckTrue(TCPAcceptorImpl.IsOpen, 'Close 1'); 478 | 479 | TCPAcceptorImpl.Close(); 480 | 481 | CheckFalse(TCPAcceptorImpl.IsOpen, 'Close 2'); 482 | end; 483 | 484 | procedure TestTTCPAcceptorImpl.TestGetIsOpen; 485 | var 486 | Endp: IPEndpoint; 487 | TCPAcceptorImpl: IPAcceptor; 488 | begin 489 | Endp := Endpoint(IPProtocol.TCP.v6, 7); 490 | 491 | TCPAcceptorImpl := NewTCPAcceptor(FService); 492 | 493 | CheckFalse(TCPAcceptorImpl.IsOpen, 'IsOpen 1'); 494 | 495 | TCPAcceptorImpl.Open(Endp.Protocol); 496 | 497 | CheckTrue(TCPAcceptorImpl.IsOpen, 'IsOpen 2'); 498 | end; 499 | 500 | procedure TestTTCPAcceptorImpl.TestGetLocalEndpoint; 501 | var 502 | Endp: IPEndpoint; 503 | TCPAcceptorImpl: IPAcceptor; 504 | begin 505 | Endp := Endpoint(IPAddressFamily.v6, 7); 506 | TCPAcceptorImpl := NewTCPAcceptor(FService); 507 | 508 | try 509 | TCPAcceptorImpl.LocalEndpoint; 510 | Fail('Failed to raise exception on unbound socket'); 511 | except 512 | on E: Exception do CheckIs(E, EOSError, 'Failed to raise OS error for unbound socket'); 513 | end; 514 | 515 | TCPAcceptorImpl.Bind(Endp); 516 | 517 | CheckEquals(Endp, TCPAcceptorImpl.LocalEndpoint, 'Wrong local endpoint'); 518 | end; 519 | 520 | procedure TestTTCPAcceptorImpl.TestGetProtocol; 521 | var 522 | Endp: IPEndpoint; 523 | TCPAcceptorImpl: IPAcceptor; 524 | begin 525 | Endp := Endpoint(IPProtocol.TCP.v6, 7); 526 | TCPAcceptorImpl := NewTCPAcceptor(FService, Endp); 527 | 528 | CheckEquals(Endp.Protocol, TCPAcceptorImpl.Protocol); 529 | end; 530 | 531 | procedure TestTTCPAcceptorImpl.TestGetService; 532 | var 533 | Endp: IPEndpoint; 534 | TCPAcceptorImpl: IPAcceptor; 535 | begin 536 | Endp := Endpoint(IPAddressFamily.v6, 7); 537 | TCPAcceptorImpl := NewTCPAcceptor(FService, Endp); 538 | 539 | CheckSame(FService, TCPAcceptorImpl.Service); 540 | end; 541 | 542 | procedure TestTTCPAcceptorImpl.TestListen; 543 | begin 544 | // TODO - use getsocketopt with SO_ACCEPTCONN 545 | end; 546 | 547 | procedure TestTTCPAcceptorImpl.TestOpen; 548 | var 549 | Protocol: IPProtocol; 550 | TCPAcceptorImpl: IPAcceptor; 551 | begin 552 | Protocol := IPProtocol.TCP.v6; 553 | TCPAcceptorImpl := NewTCPAcceptor(FService); 554 | TCPAcceptorImpl.Open(Protocol); 555 | 556 | CheckTrue(TCPAcceptorImpl.IsOpen); 557 | 558 | // use 559 | end; 560 | 561 | initialization 562 | // Register any test cases with the test runner 563 | RegisterTest(TestTTCPSocketImpl.Suite); 564 | RegisterTest(TestTTCPAcceptorImpl.Suite); 565 | end. 566 | 567 | --------------------------------------------------------------------------------