/usr/share/doc/fp-compiler/2.6.4/freebsd/demo_sendfile.pas is in fp-compiler-2.6.4 2.6.4+dfsg-4.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 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 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 | {
This program is part of the FPC demoes.
Copyright (C) 2006 by Ales Katona
A test for sendfile syscall that allows high speed streaming
of files.
The program forks to be both receiver and sender.
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
**********************************************************************}
program demo_sendfile;
{$mode objfpc}{$H+}
uses
SysUtils, BaseUnix, FreeBSD, Sockets;
procedure Bail(const Error: Integer);
begin
Writeln('Error: ', Error);
Halt(1);
end;
procedure SetupSocket(var aSocket: Integer; var aAddress: TInetSockAddr;
const aIP: string; const aPort: Word);
begin
aSocket:=fpSocket(AF_INET, SOCK_STREAM, 6);
if aSocket < 0 then
Bail(fpgeterrno);
with aAddress do begin
Family:=AF_INET;
Port:=htons(aPort);
Addr:=LongInt(StrToNetAddr(aIP));
end;
end;
procedure Sender;
var
aSocket, aFile: Integer;
Sent: Int64;
Address: TInetSockAddr;
begin
Sleep(500); // wait so the other side can start accepting
aFile:=fpOpen(ParamStr(1), O_RDONLY); // get the file fd
if aFile < 0 then
Bail(fpgeterrno);
SetupSocket(aSocket, Address, '127.0.0.1', Word(StrToInt(ParamStr(3))));
Write('SENDER: Connecting...');
if fpConnect(aSocket, @Address, sizeof(Address)) = 0 then begin
Write('SENDER: Connected.. sending.. ');
Sent:=0;
{ send the whole file in one syscall, blocking,
arguments: fd of file to send, socket to send to (blocking mode depends on it),
offset (where to begin reading/int64), count to send (0 means until EOF),
"header/trailer record", bytes sent (int64), flags (1 = don't wait for IO) }
if SendFile(aFile, aSocket, 0, 0, nil, @Sent, 0) < 0 then
Bail(fpgeterrno);
Writeln('SENDER: Sent: ', Sent, ' bytes.');
fpShutDown(aSocket, 2);
fpClose(aSocket);
end else Bail(fpgeterrno);
FpClose(aFile);
end;
procedure Receiver;
const
BUFFER_SIZE = 65535;
var
ServerSocket, ClientSocket, Received, AddressLength: Integer;
Address: TInetSockAddr;
aFile: file of Byte;
Buffer: array[0..BUFFER_SIZE] of Byte;
begin
AssignFile(aFile, ParamStr(2));
ReWrite(aFile);
SetupSocket(ServerSocket, Address, '0.0.0.0', Word(StrToInt(ParamStr(3))));
AddressLength:=SizeOf(Address);
if fpBind(ServerSocket, @Address, SizeOf(Address)) < 0 then
Bail(fpgeterrno);
if fpListen(ServerSocket, 1) < 0 then
Bail(fpgeterrno);
Write('RECEIVER: accepting... ');
ClientSocket:=fpAccept(ServerSocket, @Address, @AddressLength);
if ClientSocket < 0 then
Bail(fpgeterrno);
Write('RECEIVER: Accepted. Receiving... ');
repeat
Received:=fpRecv(ClientSocket, @Buffer[0], BUFFER_SIZE, 0);
if Received < 0 then
Bail(fpgeterrno);
BlockWrite(aFile, Buffer[0], Received);
until Received <= 0;
Writeln('RECEIVER: Done.');
CloseFile(aFile);
fpShutDown(ClientSocket, 2);
fpClose(ClientSocket);
fpClose(ServerSocket);
end;
begin
if (ParamCount = 3) and FileExists(ParamStr(1)) then begin
if fpFork > 0 then
Sender
else begin
Receiver;
end;
end else Writeln('Usage: ', ParamStr(0), ' <inputfile> <outputfile> <port>');
end.
|