Просмотр исходного кода

Amiga: sockets, fcl-net, fcl-web included.

git-svn-id: trunk@28709 -
marcus 11 лет назад
Родитель
Сommit
8c2a1ed026

+ 3 - 1
.gitattributes

@@ -2471,6 +2471,7 @@ packages/fcl-net/examples/testproto.pp svneol=native#text/plain
 packages/fcl-net/examples/testsvc.pp svneol=native#text/plain
 packages/fcl-net/examples/testsvc.pp svneol=native#text/plain
 packages/fcl-net/examples/testuri.pp svneol=native#text/plain
 packages/fcl-net/examples/testuri.pp svneol=native#text/plain
 packages/fcl-net/fpmake.pp svneol=native#text/plain
 packages/fcl-net/fpmake.pp svneol=native#text/plain
+packages/fcl-net/src/amiga/resolve.inc svneol=native#text/plain
 packages/fcl-net/src/aros/resolve.inc svneol=native#text/plain
 packages/fcl-net/src/aros/resolve.inc svneol=native#text/plain
 packages/fcl-net/src/cnetdb.pp svneol=native#text/plain
 packages/fcl-net/src/cnetdb.pp svneol=native#text/plain
 packages/fcl-net/src/fpsock.pp svneol=native#text/plain
 packages/fcl-net/src/fpsock.pp svneol=native#text/plain
@@ -6647,6 +6648,7 @@ packages/rtl-extra/src/aix/clocale.inc svneol=native#text/plain
 packages/rtl-extra/src/aix/osdefs.inc svneol=native#text/plain
 packages/rtl-extra/src/aix/osdefs.inc svneol=native#text/plain
 packages/rtl-extra/src/aix/unxsockh.inc svneol=native#text/plain
 packages/rtl-extra/src/aix/unxsockh.inc svneol=native#text/plain
 packages/rtl-extra/src/amiga/printer.pp svneol=native#text/plain
 packages/rtl-extra/src/amiga/printer.pp svneol=native#text/plain
+packages/rtl-extra/src/amiga/sockets.pp svneol=native#text/plain
 packages/rtl-extra/src/android/clocale.pp svneol=native#text/plain
 packages/rtl-extra/src/android/clocale.pp svneol=native#text/plain
 packages/rtl-extra/src/android/osdefs.inc svneol=native#text/plain
 packages/rtl-extra/src/android/osdefs.inc svneol=native#text/plain
 packages/rtl-extra/src/android/unixsock.inc svneol=native#text/plain
 packages/rtl-extra/src/android/unixsock.inc svneol=native#text/plain
@@ -14084,7 +14086,7 @@ tests/webtbs/tw2656.pp svneol=native#text/plain
 tests/webtbs/tw2659.pp svneol=native#text/plain
 tests/webtbs/tw2659.pp svneol=native#text/plain
 tests/webtbs/tw26599.pp svneol=native#text/pascal
 tests/webtbs/tw26599.pp svneol=native#text/pascal
 tests/webtbs/tw26615.pp svneol=native#text/pascal
 tests/webtbs/tw26615.pp svneol=native#text/pascal
-tests/webtbs/tw26627.pp -text svneol=native#text/plain
+tests/webtbs/tw26627.pp svneol=native#text/plain
 tests/webtbs/tw2666.pp svneol=native#text/plain
 tests/webtbs/tw2666.pp svneol=native#text/plain
 tests/webtbs/tw2668.pp svneol=native#text/plain
 tests/webtbs/tw2668.pp svneol=native#text/plain
 tests/webtbs/tw2669.pp svneol=native#text/plain
 tests/webtbs/tw2669.pp svneol=native#text/plain

+ 9 - 0
.gitignore

@@ -1344,6 +1344,15 @@ packages/fcl-net/src/*.o
 packages/fcl-net/src/*.ppu
 packages/fcl-net/src/*.ppu
 packages/fcl-net/src/*.s
 packages/fcl-net/src/*.s
 packages/fcl-net/src/Package.fpc
 packages/fcl-net/src/Package.fpc
+packages/fcl-net/src/amiga/*.bak
+packages/fcl-net/src/amiga/*.exe
+packages/fcl-net/src/amiga/*.o
+packages/fcl-net/src/amiga/*.ppu
+packages/fcl-net/src/amiga/*.s
+packages/fcl-net/src/amiga/Package.fpc
+packages/fcl-net/src/amiga/build-stamp.*
+packages/fcl-net/src/amiga/fpcmade.*
+packages/fcl-net/src/amiga/units
 packages/fcl-net/src/aros/*.bak
 packages/fcl-net/src/aros/*.bak
 packages/fcl-net/src/aros/*.exe
 packages/fcl-net/src/aros/*.exe
 packages/fcl-net/src/aros/*.o
 packages/fcl-net/src/aros/*.o

+ 1 - 1
packages/fastcgi/fpmake.pp

@@ -24,7 +24,7 @@ begin
     P.Email := '';
     P.Email := '';
     P.Description := 'FastCGI header translation to Pascal';
     P.Description := 'FastCGI header translation to Pascal';
     P.NeedLibC:= false;
     P.NeedLibC:= false;
-    P.OSes := AllUnixOSes+AllWindowsOSes-[qnx]+[aros];
+    P.OSes := AllUnixOSes+AllWindowsOSes-[qnx]+[amiga,aros];
 
 
     P.SourcePath.Add('src');
     P.SourcePath.Add('src');
 
 

+ 3 - 3
packages/fcl-net/fpmake.pp

@@ -18,7 +18,7 @@ begin
 {$endif ALLPACKAGES}
 {$endif ALLPACKAGES}
     P.Version:='2.7.1';
     P.Version:='2.7.1';
     P.Dependencies.Add('fcl-base');
     P.Dependencies.Add('fcl-base');
-    P.Dependencies.Add('openssl',AllOSes - [aros]);
+    P.Dependencies.Add('openssl',AllOSes - [amiga,aros]);
     P.Dependencies.Add('fcl-xml');
     P.Dependencies.Add('fcl-xml');
     P.Dependencies.Add('fcl-passrc');
     P.Dependencies.Add('fcl-passrc');
     P.Dependencies.Add('fcl-async',[linux,freebsd,netbsd,openbsd]);
     P.Dependencies.Add('fcl-async',[linux,freebsd,netbsd,openbsd]);
@@ -40,14 +40,14 @@ begin
 
 
     // IP and Sockets
     // IP and Sockets
     T:=P.Targets.AddUnit('netdb.pp',AllUnixOSes);
     T:=P.Targets.AddUnit('netdb.pp',AllUnixOSes);
-    T:=P.Targets.AddUnit('resolve.pp',AllUnixOSes+AllWindowsOSes+[OS2,EMX,aros]);
+    T:=P.Targets.AddUnit('resolve.pp',AllUnixOSes+AllWindowsOSes+[OS2,EMX,amiga,aros]);
       with T.Dependencies do
       with T.Dependencies do
         begin
         begin
           AddInclude('resolve.inc');
           AddInclude('resolve.inc');
           AddUnit('netdb',AllUnixOSes);
           AddUnit('netdb',AllUnixOSes);
         end;
         end;
     T.ResourceStrings := True;
     T.ResourceStrings := True;
-    T:=P.Targets.AddUnit('ssockets.pp',AllUnixOSes+AllWindowsOSes+[OS2,EMX, aros]);
+    T:=P.Targets.AddUnit('ssockets.pp',AllUnixOSes+AllWindowsOSes+[OS2,EMX, amiga,aros]);
       with T.Dependencies do
       with T.Dependencies do
         begin
         begin
           AddUnit('resolve');
           AddUnit('resolve');

+ 99 - 0
packages/fcl-net/src/amiga/resolve.inc

@@ -0,0 +1,99 @@
+
+uses
+  Sysutils;
+const
+  { Net type }
+  socklib = 'c';
+  AF_INET = 2;
+
+  { Error constants. Returned by LastError method of THost, TNet}
+
+  NETDB_INTERNAL= -1;       { see errno }
+  NETDB_SUCCESS = 0;        { no problem }
+  HOST_NOT_FOUND= 1;        { Authoritative Answer Host not found }
+  TRY_AGAIN     = 2;        { Non-Authoritive Host not found, or SERVERFAIL }
+  NO_RECOVERY   = 3;        { Non recoverable errors, FORMERR, REFUSED, NOTIMP }
+  NO_DATA       = 4;        { Valid name, no data record of requested type }
+  NO_ADDRESS    = NO_DATA;  { no address, look for MX record }
+
+
+Type
+
+  { THostEnt Object }
+  THostEnt = record
+    H_Name     : pchar;   { Official name }
+    H_Aliases  : ppchar;  { Null-terminated list of aliases}
+    H_Addrtype : longint;   { Host address type }
+    H_length  : longint;   { Length of address }
+    H_Addr : ppchar;    { null-terminated list of adresses }
+  end;
+  PHostEntry = ^THostEnt;
+
+  { TNetEnt object }
+  TNetEnt = record
+    N_Name     : pchar;   { Official name }
+    N_Aliases  : ppchar;  { Nill-terminated alias list }
+    N_AddrType : longint; { Net address type }
+    N_net      : Cardinal; { Network number }
+  end;
+  PNetEntry = ^TNetEnt;
+
+  TServEnt = record
+    s_name    : pchar;    { Service name }
+    s_aliases : ppchar;   { Null-terminated alias list }
+    s_port    : longint;  { Port number }
+    s_proto   : pchar;    { Protocol to use }
+  end;
+  PServEntry = ^TServEnt;
+
+{ C style calls, linked in from Libc }
+
+function gethostbyname(Name: PChar location 'a0'): PHostEntry; syscall SocketBase 210;
+function getnetbyname(Name: PChar location 'a0'): PNetEntry; syscall SocketBase 222;
+function getnetbyaddr(Net: Longint location 'd0'; NetType: Longint location 'd1'): PNetEntry; syscall SocketBase 228;
+function getservbyname(Name: PChar location 'a0'; Protocol: PChar location 'a1'): PServEntry; syscall SocketBase 234;
+function getservbyport(Port: LongInt location 'd0'; Protocol: PChar location 'a0'): PServEntry; syscall SocketBase 240;
+
+procedure setnetent(Stayopen: Longint location 'd0');  syscall SocketBase 516;
+procedure endnetent; syscall SocketBase 522;
+function getnetent: PNetEntry; syscall SocketBase 528;
+procedure setservent(StayOpen: longint location 'd0'); syscall SocketBase 552;
+procedure endservent; syscall SocketBase 558;
+function getservent: PServEntry; syscall SocketBase 564;
+
+function gethostbyaddr(Addr: PChar; Len: Longint; HType: Longint): PHostentry;
+var
+  addr1,
+  addr2: in_addr;
+  IP: PPLongInt;
+begin
+  Addr1 :=  in_addr(PHostAddr(Addr)^);
+  Addr2.s_addr := htonl(Addr1.s_addr);
+  gethostbyaddr := Pointer(bsd_GetHostByAddr(Pointer(@Addr2.s_addr), Len, HType));
+  if Assigned(gethostbyaddr) then
+  begin
+    ip := Pointer(gethostbyaddr^.H_Addr);
+    if Assigned(ip) then
+    begin
+      repeat
+        ip^^ := ntohl(ip^^);
+        Inc(IP);
+      until ip^ = nil; 
+    end;
+  end;
+end;
+
+function  GetDNSError: integer;
+begin
+  GetDNSError:=bsd_Errno;
+end;
+
+Function InitResolve : Boolean;
+begin
+  Result:=True;
+end;
+
+Function FinalResolve : Boolean;
+begin
+  Result:=True;
+end;

+ 1 - 1
packages/fcl-net/src/ssockets.pp

@@ -474,7 +474,7 @@ var
 begin
 begin
 {$if defined(unix)}
 {$if defined(unix)}
   fpShutdown(FSocket,SHUT_RDWR);
   fpShutdown(FSocket,SHUT_RDWR);
-{$elseif defined(mswindows) or defined(aros)}
+{$elseif defined(mswindows) or defined(aros) or defined(amiga)}
   CloseSocket(FSocket);
   CloseSocket(FSocket);
 {$else}
 {$else}
   {$WARNING Method Abort is not tested on this platform!}
   {$WARNING Method Abort is not tested on this platform!}

+ 7 - 7
packages/fcl-web/fpmake.pp

@@ -17,7 +17,7 @@ begin
     P.Directory:=ADirectory;
     P.Directory:=ADirectory;
 {$endif ALLPACKAGES}
 {$endif ALLPACKAGES}
     P.Version:='2.7.1';
     P.Version:='2.7.1';
-    P.OSes := [beos,haiku,freebsd,darwin,iphonesim,solaris,netbsd,openbsd,linux,win32,win64,wince,aix,aros];
+    P.OSes := [beos,haiku,freebsd,darwin,iphonesim,solaris,netbsd,openbsd,linux,win32,win64,wince,aix,amiga,aros];
     P.Dependencies.Add('fcl-base');
     P.Dependencies.Add('fcl-base');
     P.Dependencies.Add('fcl-db');
     P.Dependencies.Add('fcl-db');
     P.Dependencies.Add('fcl-xml');
     P.Dependencies.Add('fcl-xml');
@@ -25,8 +25,8 @@ begin
     P.Dependencies.Add('fcl-net');
     P.Dependencies.Add('fcl-net');
     P.Dependencies.Add('fcl-process');
     P.Dependencies.Add('fcl-process');
     P.Dependencies.Add('fastcgi');
     P.Dependencies.Add('fastcgi');
-    P.Dependencies.Add('httpd22', AllOses - [aros]);
-    P.Dependencies.Add('httpd24', AllOses - [aros]);
+    P.Dependencies.Add('httpd22', AllOses - [amiga,aros]);
+    P.Dependencies.Add('httpd24', AllOses - [amiga,aros]);
     // (Temporary) indirect dependencies, not detected by fpcmake:
     // (Temporary) indirect dependencies, not detected by fpcmake:
     P.Dependencies.Add('univint',[MacOSX,iphonesim]);
     P.Dependencies.Add('univint',[MacOSX,iphonesim]);
 
 
@@ -115,26 +115,26 @@ begin
       end;
       end;
     with P.Targets.AddUnit('fpfcgi.pp') do
     with P.Targets.AddUnit('fpfcgi.pp') do
       begin
       begin
-        OSes:=AllOses-[wince,darwin,iphonesim,aix,aros];
+        OSes:=AllOses-[wince,darwin,iphonesim,aix,amiga,aros];
         Dependencies.AddUnit('custfcgi');
         Dependencies.AddUnit('custfcgi');
       end;
       end;
     with P.Targets.AddUnit('custfcgi.pp') do
     with P.Targets.AddUnit('custfcgi.pp') do
       begin
       begin
-        OSes:=AllOses-[wince,darwin,iphonesim,aix,aros];
+        OSes:=AllOses-[wince,darwin,iphonesim,aix,amiga,aros];
         Dependencies.AddUnit('httpdefs');
         Dependencies.AddUnit('httpdefs');
         Dependencies.AddUnit('custweb');
         Dependencies.AddUnit('custweb');
         ResourceStrings:=true;
         ResourceStrings:=true;
       end;
       end;
     with P.Targets.AddUnit('fpapache.pp') do
     with P.Targets.AddUnit('fpapache.pp') do
       begin
       begin
-        OSes:=AllOses-[aros];
+        OSes:=AllOses-[amiga,aros];
         Dependencies.AddUnit('fphttp');
         Dependencies.AddUnit('fphttp');
         Dependencies.AddUnit('custweb');
         Dependencies.AddUnit('custweb');
         ResourceStrings:=true;
         ResourceStrings:=true;
       end;
       end;
     with P.Targets.AddUnit('fpapache24.pp') do
     with P.Targets.AddUnit('fpapache24.pp') do
       begin
       begin
-        OSes:=AllOses-[aros];
+        OSes:=AllOses-[amiga,aros];
         Dependencies.AddUnit('fphttp');
         Dependencies.AddUnit('fphttp');
         Dependencies.AddUnit('custweb');
         Dependencies.AddUnit('custweb');
         ResourceStrings:=true;
         ResourceStrings:=true;

+ 2 - 2
packages/fcl-web/src/base/fphttpclient.pp

@@ -275,7 +275,7 @@ Function EncodeURLElement(S : String) : String;
 Function DecodeURLElement(Const S : String) : String;
 Function DecodeURLElement(Const S : String) : String;
 
 
 implementation
 implementation
-{$ifndef AROS}
+{$if not defined(aros) and not defined(amiga)}
 uses sslsockets;
 uses sslsockets;
 {$endif}
 {$endif}
 
 
@@ -427,7 +427,7 @@ begin
   if Assigned(FonGetSocketHandler) then
   if Assigned(FonGetSocketHandler) then
     FOnGetSocketHandler(Self,UseSSL,Result);
     FOnGetSocketHandler(Self,UseSSL,Result);
   if (Result=Nil) then
   if (Result=Nil) then
-  {$ifndef AROS}  
+  {$if not defined(AROS) and not defined(Amiga)}  
     If UseSSL then
     If UseSSL then
       Result:=TSSLSocketHandler.Create
       Result:=TSSLSocketHandler.Create
     else
     else

+ 2 - 1
packages/rtl-extra/fpmake.pp

@@ -28,7 +28,7 @@ Const
   WinsockOSes   = [win32,win64,wince,os2,emx,netware,netwlibc];
   WinsockOSes   = [win32,win64,wince,os2,emx,netware,netwlibc];
   WinSock2OSes  = [win32,win64,wince];
   WinSock2OSes  = [win32,win64,wince];
   // sockets of  morphos is implemented, but not active
   // sockets of  morphos is implemented, but not active
-  SocketsOSes   = UnixLikes+[aros,netware,netwlibc,os2,wince,win32,win64];
+  SocketsOSes   = UnixLikes+[amiga,aros,netware,netwlibc,os2,wince,win32,win64];
   Socksyscall   = [beos,freebsd,haiku,linux,netbsd,openbsd];
   Socksyscall   = [beos,freebsd,haiku,linux,netbsd,openbsd];
   Socklibc	= unixlikes-socksyscall;
   Socklibc	= unixlikes-socksyscall;
   gpmOSes	= [Linux,Android];
   gpmOSes	= [Linux,Android];
@@ -54,6 +54,7 @@ begin
     P.NeedLibC:= false;
     P.NeedLibC:= false;
     P.Dependencies.Add('morphunits',[morphos]);
     P.Dependencies.Add('morphunits',[morphos]);
     P.Dependencies.Add('arosunits',[aros]);
     P.Dependencies.Add('arosunits',[aros]);
+    P.Dependencies.Add('amunits',[amiga]);
 
 
     P.SourcePath.Add('src/inc');
     P.SourcePath.Add('src/inc');
     P.SourcePath.Add('src/$(OS)');
     P.SourcePath.Add('src/$(OS)');

+ 271 - 0
packages/rtl-extra/src/amiga/sockets.pp

@@ -0,0 +1,271 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1999-2007 by the Free Pascal development team
+
+    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.
+
+ **********************************************************************}
+{$PACKRECORDS 2}
+unit Sockets;
+Interface
+
+uses
+  ctypes,exec;
+
+type
+    size_t   = cuint32;         { as definied in the C standard}
+    ssize_t  = cint32;          { used by function for returning number of bytes}
+
+    socklen_t= cuint32;
+    TSocklen = socklen_t;
+    pSocklen = ^socklen_t;
+
+
+//{ $i unxsockh.inc}
+{$define BSD}
+{$define SOCK_HAS_SINLEN}
+{$i socketsh.inc}
+
+type
+  TUnixSockAddr = packed Record
+                  sa_len     : cuchar;
+                  family       : sa_family_t;
+                  path:array[0..107] of char;    //104 total for freebsd.
+                  end;
+
+type
+  hostent = record
+    h_name     : PChar;
+    h_aliases  : PPChar;
+    h_addrtype : LongInt;
+    h_Length   : LongInt;
+    h_addr_list: ^PDWord;
+  end;
+  THostEnt = hostent;
+  PHostEnt = ^THostEnt;
+
+
+const
+  AF_UNSPEC      = 0;               {* unspecified *}
+  AF_LOCAL       = 1;               {* local to host (pipes, portals) *}
+  AF_UNIX        = AF_LOCAL;        {* backward compatibility *}
+  AF_INET        = 2;               {* internetwork: UDP, TCP, etc. *}
+  AF_IMPLINK     = 3;               {* arpanet imp addresses *}
+  AF_PUP         = 4;               {* pup protocols: e.g. BSP *}
+  AF_CHAOS       = 5;               {* mit CHAOS protocols *}
+  AF_NS          = 6;               {* XEROX NS protocols *}
+  AF_ISO         = 7;               {* ISO protocols *}
+  AF_OSI         = AF_ISO;
+  AF_ECMA        = 8;               {* european computer manufacturers *}
+  AF_DATAKIT     = 9;               {* datakit protocols *}
+  AF_CCITT       = 10;              {* CCITT protocols, X.25 etc *}
+  AF_SNA         = 11;              {* IBM SNA *}
+  AF_DECnet      = 12;              {* DECnet *}
+  AF_DLI         = 13;              {* DEC Direct data link interface *}
+  AF_LAT         = 14;              {* LAT *}
+  AF_HYLINK      = 15;              {* NSC Hyperchannel *}
+  AF_APPLETALK   = 16;              {* Apple Talk *}
+  AF_ROUTE       = 17;              {* Internal Routing Protocol *}
+  AF_LINK        = 18;              {* Link layer interface *}
+  pseudo_AF_XTP  = 19;              {* eXpress Transfer Protocol (no AF) *}
+  AF_COIP        = 20;              {* connection-oriented IP, aka ST II *}
+  AF_CNT         = 21;              {* Computer Network Technology *}
+  pseudo_AF_RTIP = 22;              {* Help Identify RTIP packets *}
+  AF_IPX         = 23;              {* Novell Internet Protocol *}
+  AF_SIP         = 24;              {* Simple Internet Protocol *}
+  pseudo_AF_PIP  = 25;              {* Help Identify PIP packets *}
+
+  AF_MAX         = 26;
+  SO_LINGER     = $0080;
+  SOL_SOCKET    = $FFFF;
+
+const
+  EsockEINTR            = 4; // EsysEINTR;   
+  EsockEBADF            = 9; // EsysEBADF;
+  EsockEFAULT           = 14; // EsysEFAULT;
+  EsockEINVAL           = 22; //EsysEINVAL;
+  EsockEACCESS          = 13; //ESysEAcces;
+  EsockEMFILE           = 24; //ESysEmfile;
+  EsockENOBUFS          = 55; //ESysENoBufs;
+  EsockENOTCONN         = 57; //ESysENotConn;
+  EsockEPROTONOSUPPORT  = 43; //ESysEProtoNoSupport;
+  EsockEWOULDBLOCK      = 35; //ESysEWouldBlock; // same as eagain on morphos
+
+{ unix socket specific functions }
+{*
+Procedure Str2UnixSockAddr(const addr:string;var t:TUnixSockAddr;var len:longint); deprecated;
+Function Bind(Sock:longint;const addr:string):boolean; deprecated;
+Function Connect(Sock:longint;const addr:string;var SockIn,SockOut:text):Boolean; deprecated;
+Function Connect(Sock:longint;const addr:string;var SockIn,SockOut:file):Boolean; deprecated;
+Function Accept(Sock:longint;var addr:string;var SockIn,SockOut:text):Boolean;    deprecated;
+Function Accept(Sock:longint;var addr:string;var SockIn,SockOut:File):Boolean;    deprecated;
+*}
+//function  fpaccept      (s:cint; addrx : psockaddr; addrlen : psocklen):cint; maybelibc
+//function  fpbind      (s:cint; addrx : psockaddr; addrlen : tsocklen):cint;  maybelibc
+//function  fpconnect     (s:cint; name  : psockaddr; namelen : tsocklen):cint;  maybelibc
+
+var
+  SocketBase: PLibrary;
+
+function bsd_socket(Domain: LongInt location 'd0'; Type_: LongInt location 'd1'; Protocol: LongInt location 'd2'): LongInt; syscall SocketBase 30;
+function bsd_bind(s: LongInt location 'd0'; const name: PSockAddr location 'a0'; NameLen: LongInt location 'd1'): LongInt; syscall SocketBase 36;
+function bsd_listen(s: LongInt location 'd0'; BackLog: LongInt location 'd1'): LongInt; syscall SocketBase 42;
+function bsd_accept(s: LongInt location 'd0'; Addr: PSockaddr location 'a0'; AddrLen: PSockLen location 'a1'): LongInt; syscall SocketBase 48;
+function bsd_connect(s : LongInt location 'd0'; const Name: PSockaddr location 'a0'; NameLen: LongInt location 'd1'): LongInt; syscall SocketBase 54;
+function bsd_sendto(s: LongInt location 'd0'; const Msg: PChar location 'a0'; Len: LongInt location 'd1'; Flags: LongInt location 'd2'; const To_: PSockaddr location 'a1'; ToLen: LongInt location 'd3'): LongInt; syscall SocketBase 60;
+function bsd_send(s: LongInt location 'd0'; const msg: PChar location 'a0'; Len: LongInt location 'd1'; Flags: LongInt location 'd2'): LongInt; syscall SocketBase 66;
+function bsd_recvfrom(s: LongInt location 'd0'; Buf: PChar location 'a0'; Len: LongInt location 'd1'; Flags: LongInt location 'd2'; From: PSockaddr location 'a1'; FromLen: PSockLen location 'a2'): LongInt; syscall SocketBase 72;
+function bsd_recv(s: LongInt location 'd0'; buf: PChar location 'a0'; Len: LongInt location 'd1'; Flags: LongInt location 'd2'): LongInt; syscall SocketBase 78;
+function bsd_shutdown(s: LongInt location 'd0'; How: LongInt location 'd1'): LongInt; syscall SocketBase 84;
+function bsd_setsockopt(s: LongInt location 'd0'; level: LongInt location 'd1'; optname: LongInt location 'd2'; const optval: Pointer location 'a0'; optlen: LongInt location 'd3') : LongInt; syscall SocketBase 90;
+function bsd_getsockopt(s: LongInt location 'd0'; Level: LongInt location 'd1'; OptName: LongInt location 'd2'; OptVal: Pointer location 'a0'; OptLen: PSockLen location 'a1'): LongInt; syscall SocketBase 96;
+function bsd_getsockname(s: LongInt location 'd0'; HostName: PSockaddr location 'a0'; NameLen: PSockLen location 'a1'): LongInt; syscall SocketBase 102;
+function bsd_getpeername(s: LongInt location 'd0'; HostName: PSockaddr location 'a0'; NameLen: PSockLen location 'a1'): LongInt; syscall SocketBase 108;
+function bsd_closesocket(s: LongInt location 'd0'): LongInt; syscall SocketBase 120;
+function bsd_Errno: LongInt; syscall SocketBase 162;
+function bsd_inet_ntoa(in_: LongWord location 'd0'): PChar; syscall SocketBase 174;
+function bsd_inet_addr(const cp: PChar location 'a0'): LongWord; syscall SocketBase 180;
+function bsd_gethostbyname(const Name: PChar location 'a0'): PHostEnt; syscall SocketBase 210;
+function bsd_gethostbyaddr(const Addr: PByte location 'a0'; Len: LongInt location 'd0'; Type_: LongInt location 'd1'): PHostEnt; syscall SocketBase 216;
+
+Implementation
+
+threadvar internal_socketerror: cint;
+
+{ Include filerec and textrec structures }
+{.$i filerec.inc}
+{.$i textrec.inc}
+
+{******************************************************************************
+                          Kernel Socket Callings
+******************************************************************************}
+
+function socketerror: cint;
+begin
+  socketerror := internal_socketerror;
+end;
+
+function fpgeterrno: longint; inline;
+begin
+  fpgeterrno := bsd_Errno;
+end;
+
+function fpClose(d: LongInt): LongInt; inline;
+begin
+  fpClose := bsd_CloseSocket(d);
+end;
+
+function fpaccept(s: cint; addrx: PSockaddr; Addrlen: PSocklen): cint;
+begin
+  fpaccept := bsd_accept(s,addrx,addrlen);
+  internal_socketerror := fpgeterrno; 
+end;
+
+function fpbind(s:cint; addrx: psockaddr; addrlen: tsocklen): cint;
+begin
+  fpbind := bsd_bind(s, addrx, addrlen);
+  internal_socketerror := fpgeterrno;
+end;
+
+function fpconnect(s:cint; name: psockaddr; namelen: tsocklen): cint;
+begin
+  fpconnect := bsd_connect(s, name, namelen);
+  internal_socketerror := fpgeterrno;
+end;
+
+function fpgetpeername (s:cint; name  : psockaddr; namelen : psocklen):cint;
+begin
+  fpgetpeername := bsd_getpeername(s,name,namelen);
+  internal_socketerror := fpgeterrno;
+end;
+
+function fpgetsockname(s:cint; name  : psockaddr; namelen : psocklen):cint;
+begin
+  fpgetsockname := bsd_getsockname(s,name,namelen);
+  internal_socketerror := fpgeterrno;
+end;
+
+function fpgetsockopt  (s:cint; level:cint; optname:cint; optval:pointer; optlen : psocklen):cint;
+begin
+  fpgetsockopt := bsd_getsockopt(s,level,optname,optval,optlen);
+  internal_socketerror := fpgeterrno;
+end;
+
+function fplisten(s:cint; backlog : cint):cint;
+begin
+  fplisten := bsd_listen(s, backlog);
+  internal_socketerror := fpgeterrno;
+end;
+
+function fprecv(s:cint; buf: pointer; len: size_t; Flags: cint): ssize_t;
+begin
+  fprecv := bsd_recv(s,buf,len,flags);
+  internal_socketerror := fpgeterrno;
+end;
+
+function fprecvfrom(s:cint; buf: pointer; len: size_t; flags: cint; from : psockaddr; fromlen : psocklen):ssize_t;
+begin
+  fprecvfrom := bsd_recvfrom(s, buf, len, flags, from, fromlen);
+  internal_socketerror := fpgeterrno;
+end;
+
+function fpsend(s:cint; msg:pointer; len:size_t; flags:cint):ssize_t;
+begin
+  fpsend := bsd_send(s, msg, len, flags);
+  internal_socketerror := fpgeterrno;
+end;
+
+function fpsendto(s:cint; msg:pointer; len:size_t; flags:cint; tox :psockaddr; tolen: tsocklen):ssize_t;
+begin
+  fpsendto := bsd_sendto(s, msg, len, flags, tox, tolen);
+  internal_socketerror := fpgeterrno;
+end;
+
+function fpsetsockopt(s:cint; level:cint; optname:cint; optval:pointer; optlen :tsocklen):cint;
+begin
+  fpsetsockopt := bsd_setsockopt(s, level, optname, optval, optlen);
+  internal_socketerror := fpgeterrno;
+end;
+
+function fpshutdown(s: cint; how: cint): cint;
+begin
+  fpshutdown := bsd_shutdown(s, how);
+  internal_socketerror := fpgeterrno;
+end;
+
+function fpsocket(domain: cint; xtype: cint; protocol: cint): cint;
+begin
+  fpsocket := bsd_socket(domain, xtype, protocol);
+  internal_socketerror := fpgeterrno;
+end;
+
+
+function fpsocketpair(d:cint; xtype:cint; protocol:cint; sv:pcint):cint;
+begin
+{
+  fpsocketpair:=cfpsocketpair(d,xtype,protocol,sv);
+  internal_socketerror:=fpgeterrno;
+}
+  fpsocketpair:=-1;
+end;
+
+
+{$i sockovl.inc}
+{$i sockets.inc}
+
+// FIXME: this doesn't make any sense here, because SocketBase should be task-specific
+// but FPC doesn't support that yet (TODO)
+{$WARNING FIX ME, TODO}
+
+
+initialization
+  SocketBase := OpenLibrary('bsdsocket.library',0);
+finalization
+  if SocketBase <> nil then
+    CloseLibrary(SocketBase);
+end.

+ 11 - 11
tests/webtbs/tw26627.pp

@@ -1,16 +1,16 @@
-program test;
-
-{$mode objfpc}{$h+}
-
-uses SysUtils;
-
-var a: ansistring;
-
+program test;
+
+{$mode objfpc}{$h+}
+
+uses SysUtils;
+
+var a: ansistring;
+
 begin
 begin
   defaultfilesystemcodepage:=CP_UTF8;
   defaultfilesystemcodepage:=CP_UTF8;
-  defaultrtlfilesystemcodepage:=CP_ASCII;
-  a := DirectorySeparator+'.';
+  defaultrtlfilesystemcodepage:=CP_ASCII;
+  a := DirectorySeparator+'.';
   a := ExpandFileName(a);
   a := ExpandFileName(a);
   if StringCodePage(a)<> defaultrtlfilesystemcodepage then
   if StringCodePage(a)<> defaultrtlfilesystemcodepage then
-   halt(1);
+   halt(1);
 end.
 end.