Explorar o código

* CloseSocket added

armin %!s(int64=22) %!d(string=hai) anos
pai
achega
e321c72b22
Modificáronse 6 ficheiros con 302 adicións e 135 borrados
  1. 11 1
      rtl/freebsd/unixsock.inc
  2. 5 1
      rtl/inc/socketsh.inc
  3. 11 1
      rtl/linux/unixsock.inc
  4. 11 1
      rtl/netbsd/unixsock.inc
  5. 245 130
      rtl/netware/sockets.pp
  6. 19 1
      rtl/win32/sockets.pp

+ 11 - 1
rtl/freebsd/unixsock.inc

@@ -11,6 +11,13 @@ begin
   Socket:=Do_Syscall(syscall_nr_socket,Domain,SocketType,Protocol);
   Socket:=Do_Syscall(syscall_nr_socket,Domain,SocketType,Protocol);
 end;
 end;
 
 
+Function CloseSocket (Sock:Longint):Longint;
+begin
+  if fdClose (Sock) then
+    CloseSocket := 0 else
+    CloseSocket := -1;
+end;
+
 Function Send(Sock:Longint;Const Buf;BufLen,Flags:Longint):Longint;
 Function Send(Sock:Longint;Const Buf;BufLen,Flags:Longint):Longint;
 begin
 begin
   Send:=do_syscall(syscall_nr_sendto,Sock,Longint(@Buf),BufLen,Flags,0,0);
   Send:=do_syscall(syscall_nr_sendto,Sock,Longint(@Buf),BufLen,Flags,0,0);
@@ -192,7 +199,10 @@ end;
 
 
 {
 {
  $Log$
  $Log$
- Revision 1.6  2002-09-07 16:01:18  peter
+ Revision 1.7  2003-03-23 17:47:15  armin
+ * CloseSocket added
+
+ Revision 1.6  2002/09/07 16:01:18  peter
    * old logs removed and tabs fixed
    * old logs removed and tabs fixed
 
 
  Revision 1.5  2002/02/05 07:54:34  marco
  Revision 1.5  2002/02/05 07:54:34  marco

+ 5 - 1
rtl/inc/socketsh.inc

@@ -132,6 +132,7 @@ Var
 
 
 {Basic Socket Functions}
 {Basic Socket Functions}
 Function Socket(Domain,SocketType,Protocol:Longint):Longint;
 Function Socket(Domain,SocketType,Protocol:Longint):Longint;
+Function CloseSocket(Sock:Longint):Longint;
 Function Send(Sock:Longint;Const Buf;BufLen,Flags:Longint):Longint;
 Function Send(Sock:Longint;Const Buf;BufLen,Flags:Longint):Longint;
 Function SendTo(Sock:Longint;Const Buf;BufLen,Flags:Longint;Var Addr; AddrLen : Longint):Longint;
 Function SendTo(Sock:Longint;Const Buf;BufLen,Flags:Longint;Var Addr; AddrLen : Longint):Longint;
 Function Recv(Sock:Longint;Var Buf;BufLen,Flags:Longint):Longint;
 Function Recv(Sock:Longint;Var Buf;BufLen,Flags:Longint):Longint;
@@ -161,7 +162,10 @@ Function Connect(Sock:longint;const addr:TInetSockAddr;var SockIn,SockOut:file):
 
 
 {
 {
   $Log$
   $Log$
-  Revision 1.8  2002-09-07 15:07:46  peter
+  Revision 1.9  2003-03-23 17:47:15  armin
+  * CloseSocket added
+
+  Revision 1.8  2002/09/07 15:07:46  peter
     * old logs removed and tabs fixed
     * old logs removed and tabs fixed
 
 
   Revision 1.7  2002/02/04 21:29:34  michael
   Revision 1.7  2002/02/04 21:29:34  michael

+ 11 - 1
rtl/linux/unixsock.inc

@@ -78,6 +78,13 @@ begin
   Socket:=SocketCall(Socket_Sys_Socket,Domain,SocketType,ProtoCol);
   Socket:=SocketCall(Socket_Sys_Socket,Domain,SocketType,ProtoCol);
 end;
 end;
 
 
+Function CloseSocket (Sock:Longint):Longint;
+begin
+  if fdClose (Sock) then
+    CloseSocket := 0 else
+    CloseSocket := -1;
+end;
+
 Function Send(Sock:Longint;Const Buf;BufLen,Flags:Longint):Longint;
 Function Send(Sock:Longint;Const Buf;BufLen,Flags:Longint):Longint;
 begin
 begin
   Send:=SocketCall(Socket_Sys_Send,Sock,Longint(@Buf),BufLen,Flags,0,0);
   Send:=SocketCall(Socket_Sys_Send,Sock,Longint(@Buf),BufLen,Flags,0,0);
@@ -267,7 +274,10 @@ end;
 
 
 {
 {
   $Log$
   $Log$
-  Revision 1.6  2002-09-07 16:01:20  peter
+  Revision 1.7  2003-03-23 17:47:15  armin
+  * CloseSocket added
+
+  Revision 1.6  2002/09/07 16:01:20  peter
     * old logs removed and tabs fixed
     * old logs removed and tabs fixed
 
 
   Revision 1.5  2002/02/04 21:29:34  michael
   Revision 1.5  2002/02/04 21:29:34  michael

+ 11 - 1
rtl/netbsd/unixsock.inc

@@ -9,6 +9,13 @@ begin
   Socket:=Do_Syscall(syscall_nr_socket,Domain,SocketType,Protocol);
   Socket:=Do_Syscall(syscall_nr_socket,Domain,SocketType,Protocol);
 end;
 end;
 
 
+Function CloseSocket (Sock:Longint):Longint;
+begin
+  if fdClose (Sock) then
+    CloseSocket := 0 else
+    CloseSocket := -1;
+end;
+
 Function Send(Sock:Longint;Const Buf;BufLen,Flags:Longint):Longint;
 Function Send(Sock:Longint;Const Buf;BufLen,Flags:Longint):Longint;
 begin
 begin
   Send:=do_syscall(syscall_nr_sendto,Sock,Longint(@Buf),BufLen,Flags,0,0);
   Send:=do_syscall(syscall_nr_sendto,Sock,Longint(@Buf),BufLen,Flags,0,0);
@@ -190,7 +197,10 @@ end;
 
 
 {
 {
  $Log$
  $Log$
- Revision 1.2  2003-01-21 15:39:45  marco
+ Revision 1.3  2003-03-23 17:47:15  armin
+ * CloseSocket added
+
+ Revision 1.2  2003/01/21 15:39:45  marco
   * NetBSD first rtl. Still not 100%, but close
   * NetBSD first rtl. Still not 100%, but close
 
 
  Revision 1.1.2.3  2002/09/20 07:06:15  pierre
  Revision 1.1.2.3  2002/09/20 07:06:15  pierre

+ 245 - 130
rtl/netware/sockets.pp

@@ -1,4 +1,4 @@
-{ Netware:UNTESTED !!
+{
     $Id$
     $Id$
     This file is part of the Free Pascal run time library.
     This file is part of the Free Pascal run time library.
     Copyright (c) 1999-2000 by the Free Pascal development team
     Copyright (c) 1999-2000 by the Free Pascal development team
@@ -11,156 +11,271 @@
     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
 
  **********************************************************************}
  **********************************************************************}
+{$mode objfpc}
 unit Sockets;
 unit Sockets;
+
 Interface
 Interface
 
 
-const
- {$Ifndef BSD}
-  { Adress families, Linux specific }
-  AF_AX25         = 3;      { Amateur Radio AX.25          }
-  AF_IPX          = 4;      { Novell IPX                   }
-  AF_APPLETALK    = 5;      { Appletalk DDP                }
-  AF_NETROM       = 6;      { Amateur radio NetROM         }
-  AF_BRIDGE       = 7;       { Multiprotocol bridge         }
-  AF_AAL5         = 8;       { Reserved for Werner's ATM    }
-  AF_X25          = 9;       { Reserved for X.25 project    }
-  AF_INET6        = 10;      { IP version 6                 }
-  AF_MAX          = 12;
-
-  SOCK_PACKET     = 10;
-
-  PF_AX25         = AF_AX25;
-  PF_IPX          = AF_IPX;
-  PF_APPLETALK    = AF_APPLETALK;
-  PF_NETROM       = AF_NETROM;
-  PF_BRIDGE       = AF_BRIDGE;
-  PF_AAL5         = AF_AAL5;
-  PF_X25          = AF_X25;
-  PF_INET6        = AF_INET6;
-
-  PF_MAX          = AF_MAX;
- {$ELSE}
- {BSD}
-  AF_LOCAL        =1;              { local to host (pipes, portals) }
-  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_ISDN         =26;             { Integrated Services Digital Network}
-  AF_E164         =AF_ISDN;        { CCITT E.164 recommendation }
-  pseudo_AF_KEY   =27;             { Internal key-management function }
-  AF_INET6        =28;             { IPv6 }
-  AF_NATM         =29;             { native ATM access }
-  AF_ATM          =30;             { ATM }
-  pseudo_AF_HDRCMPLT=31;           { Used by BPF to not rewrite headers
-                                    in interface output routine}
-  AF_NETGRAPH     =32;             { Netgraph sockets }
-  AF_MAX          =33;
-
-  SOCK_MAXADDRLEN =255;             { longest possible addresses }
+  Uses
+     winsock;
 
 
-{
-* Protocol families, same as address families for now.
-}
-  PF_LOCAL        =AF_LOCAL;
-  PF_IMPLINK      =AF_IMPLINK;
-  PF_PUP          =AF_PUP;
-  PF_CHAOS        =AF_CHAOS;
-  PF_NS           =AF_NS;
-  PF_ISO          =AF_ISO;
-  PF_OSI          =AF_ISO;
-  PF_ECMA         =AF_ECMA;
-  PF_DATAKIT      =AF_DATAKIT;
-  PF_CCITT        =AF_CCITT;
-  PF_SNA          =AF_SNA;
-  PF_DECnet       =AF_DECnet;
-  PF_DLI          =AF_DLI;
-  PF_LAT          =AF_LAT;
-  PF_HYLINK       =AF_HYLINK;
-  PF_APPLETALK    =AF_APPLETALK;
-  PF_ROUTE        =AF_ROUTE;
-  PF_LINK         =AF_LINK;
-  PF_XTP          =pseudo_AF_XTP;  { really just proto family, no AF }
-  PF_COIP         =AF_COIP;
-  PF_CNT          =AF_CNT;
-  PF_SIP          =AF_SIP;
-  PF_IPX          =AF_IPX;         { same format as AF_NS }
-  PF_RTIP         =pseudo_AF_RTIP; { same format as AF_INET }
-  PF_PIP          =pseudo_AF_PIP;
-  PF_ISDN         =AF_ISDN;
-  PF_KEY          =pseudo_AF_KEY;
-  PF_INET6        =AF_INET6;
-  PF_NATM         =AF_NATM;
-  PF_ATM          =AF_ATM;
-  PF_NETGRAPH     =AF_NETGRAPH;
-  PF_MAX          =AF_MAX;
-{$ENDIF}
-
-type
-  TUnixSockAddr = packed Record
-    family:word; { was byte, fixed }
-    path:array[0..108] of char;
-    end;
+  Const
+     AF_MAX          = WinSock.AF_MAX;
+     PF_MAX          = AF_MAX;
 
 
 {$i socketsh.inc}
 {$i socketsh.inc}
 
 
-{ unix socket specific functions }
-Procedure Str2UnixSockAddr(const addr:string;var t:TUnixSockAddr;var len:longint);
-Function Bind(Sock:longint;const addr:string):boolean;
-Function Connect(Sock:longint;const addr:string;var SockIn,SockOut:text):Boolean;
-Function Connect(Sock:longint;const addr:string;var SockIn,SockOut:file):Boolean;
-Function Accept(Sock:longint;var addr:string;var SockIn,SockOut:text):Boolean;
-Function Accept(Sock:longint;var addr:string;var SockIn,SockOut:File):Boolean;
-
 Implementation
 Implementation
-{$ifndef netware}
-Uses Unix;
-{$endif}
 
 
 { Include filerec and textrec structures }
 { Include filerec and textrec structures }
 {$i filerec.inc}
 {$i filerec.inc}
 {$i textrec.inc}
 {$i textrec.inc}
+
 {******************************************************************************
 {******************************************************************************
-                          Kernel Socket Callings
+                          Basic Socket Functions
 ******************************************************************************}
 ******************************************************************************}
 
 
-{$ifdef BSD}
- {$I bsdsock.inc}
-{$else}
- {$ifdef netware}
-   {$I nwsock.inc}
- {$else}
-   {$I linsock.inc}
- {$endif}
-{$endif}
+Function socket(Domain,SocketType,Protocol:Longint):Longint;
+begin
+  Socket:=WinSock.Socket(Domain,SocketType,ProtoCol);
+  if Socket<0 then
+    SocketError:=WSAGetLastError
+  else
+    SocketError:=0;
+end;
+
+Function CloseSocket(Sock:Longint):Longint;
+var i : longint;
+begin
+  i := Winsock.CloseSocket (Sock);
+  if i <> 0 then
+  begin
+    SocketError:=WSAGetLastError;
+    CloseSocket := i;
+  end else
+  begin
+    CloseSocket := 0;
+    SocketError := 0;
+  end;
+end;
+
+Function Send(Sock:Longint;const Buf;BufLen,Flags:Longint):Longint;
+begin
+  Send:=WinSock.Send(Sock,Buf,BufLen,Flags);
+  if Send<0 then
+    SocketError:=WSAGetLastError
+  else
+    SocketError:=0;
+end;
+
+Function SendTo(Sock:Longint;Const Buf;BufLen,Flags:Longint;Var Addr; AddrLen : Longint):Longint;
+begin
+  // Dubious construct, this should be checked.
+  SendTo:=WinSock.SendTo(Sock,Buf,BufLen,Flags,Winsock.TSockAddr(Addr),AddrLen);
+  if SendTo<0 then
+    SocketError:=WSAGetLastError
+  else
+    SocketError:=0;
+end;
+
+Function Recv(Sock:Longint;Var Buf;BufLen,Flags:Longint):Longint;
+begin
+  Recv:=WinSock.Recv(Sock,Buf,BufLen,Flags);
+  if Recv<0 then
+    SocketError:=WSAGetLastError
+  else
+    SocketError:=0;
+end;
+
+
+Function RecvFrom(Sock : Longint; Var Buf; Buflen,Flags : Longint; Var Addr; AddrLen : Integer) : longint;
+
+begin
+  RecvFrom:=WinSock.RecvFrom(Sock,Buf,BufLen,Flags,Winsock.TSockAddr(Addr),AddrLen);
+  if RecvFrom<0 then
+    SocketError:=WSAGetLastError
+  else
+    SocketError:=0;
+end;
+
+Function Bind(Sock:Longint;Const Addr;AddrLen:Longint):Boolean;
+
+  var
+     l : longint;
+
+begin
+  l:=WinSock.Bind(Sock,WinSock.PSockAddr(@Addr),AddrLen);
+  if l<0 then
+    begin
+       SocketError:=WSAGetLastError;
+       Bind:=false;
+    end
+  else
+    begin
+       SocketError:=0;
+       Bind:=true;
+    end;
+end;
+
+Function Listen(Sock,MaxConnect:Longint):Boolean;
+
+  var
+     l : longint;
+
+begin
+  l:=WinSock.Listen(Sock,MaxConnect);
+  if l<0 then
+    begin
+       SocketError:=WSAGetLastError;
+       Listen:=false;
+    end
+  else
+    begin
+       SocketError:=0;
+       Listen:=true;
+    end;
+end;
+
+Function Accept(Sock:Longint;Var Addr;Var Addrlen:Longint):Longint;
+begin
+  Accept:=WinSock.Accept(Sock,WinSock.PSockAddr(@Addr),plongint(@AddrLen));
+  if Accept<0 then
+    SocketError:=WSAGetLastError
+  else
+    SocketError:=0;
+end;
+
+Function Connect(Sock:Longint;Const Addr;Addrlen:Longint):Boolean;
+
+begin
+  Connect:=WinSock.Connect(Sock,@WinSock.TSockAddr(Addr),AddrLen)=0;
+  if not Connect then
+    SocketError:=WSAGetLastError
+  else
+    SocketError:=0;
+end;
+
+Function Shutdown(Sock:Longint;How:Longint):Longint;
+begin
+  ShutDown:=WinSock.ShutDown(Sock,How);
+  if ShutDown<0 then
+    SocketError:=WSAGetLastError
+  else
+    SocketError:=0;
+end;
+
+Function GetSocketName(Sock:Longint;Var Addr;Var Addrlen:Longint):Longint;
+begin
+  GetSocketName:=WinSock.GetSockName(Sock,WinSock.TSockAddr(Addr),AddrLen);
+  if GetSocketName<0 then
+    SocketError:=WSAGetLastError
+  else
+    SocketError:=0;
+end;
+
+Function GetPeerName(Sock:Longint;Var Addr;Var Addrlen:Longint):Longint;
+begin
+  GetPeerName:=WinSock.GetPeerName(Sock,WinSock.TSockAddr(Addr),AddrLen);
+  if GetPeerName<0 then
+    SocketError:=WSAGetLastError
+  else
+    SocketError:=0;
+end;
+
+Function SetSocketOptions(Sock,Level,OptName:Longint;Const OptVal;optlen:longint):Longint;
+begin
+  SetSocketOptions:=WinSock.SetSockOpt(Sock,Level,OptName,pchar(@OptVal),OptLen);
+  if SetSocketOptions<0 then
+    SocketError:=WSAGetLastError
+  else
+    SocketError:=0;
+end;
+
+Function GetSocketOptions(Sock,Level,OptName:Longint;Var OptVal;Var optlen:longint):Longint;
+begin
+  GetSocketOptions:=WinSock.GetSockOpt(Sock,Level,OptName,OptVal,OptLen);
+  if GetSocketOptions<0 then
+    SocketError:=WSAGetLastError
+  else
+    SocketError:=0;
+end;
+
+Function SocketPair(Domain,SocketType,Protocol:Longint;var Pair:TSockArray):Longint;
+begin
+  // SocketPair:=SocketCall(Socket_Sys_SocketPair,Domain,SocketType,Protocol,longint(@Pair),0,0);
+end;
+
+
+{ mimic the linux fdWrite/fdRead calls for the file/text socket wrapper }
+function fdWrite(handle : longint;Const bufptr;size : dword) : dword;
+begin
+  fdWrite := dword(WinSock.send(handle, bufptr, size, 0));
+  if fdWrite = dword(SOCKET_ERROR) then
+  begin
+    SocketError := WSAGetLastError;
+    fdWrite := 0;
+  end
+  else
+    SocketError := 0;
+end;
+
+function fdRead(handle : longint;var bufptr;size : dword) : dword;
+  var
+     d : dword;
+
+  begin
+     if ioctlsocket(handle,FIONREAD,@d) = SOCKET_ERROR then
+       begin
+         SocketError:=WSAGetLastError;
+         fdRead:=0;
+         exit;
+       end;
+     if d>0 then
+       begin
+         if size>d then
+           size:=d;
+         fdRead := dword(WinSock.recv(handle, bufptr, size, 0));
+         if fdRead = dword(SOCKET_ERROR) then
+         begin
+           SocketError:= WSAGetLastError;
+           fdRead := 0;
+         end else
+           SocketError:=0;
+       end
+     else
+       SocketError:=0;
+  end;
+
 
 
 {$i sockets.inc}
 {$i sockets.inc}
 
 
-end.
+{ winsocket stack needs an init. and cleanup code }
+var
+  wsadata : twsadata;
 
 
+initialization
+  WSAStartUp($2,wsadata);
+finalization
+  WSACleanUp;
+end.
 {
 {
   $Log$
   $Log$
-  Revision 1.2  2002-09-07 16:01:21  peter
+  Revision 1.3  2003-03-23 17:47:15  armin
+  * CloseSocket added
+
+  Revision 1.10  2003/01/01 14:34:22  peter
+    * sendto overload
+
+  Revision 1.9  2002/09/07 16:01:29  peter
     * old logs removed and tabs fixed
     * old logs removed and tabs fixed
 
 
+  Revision 1.8  2002/07/17 07:28:21  pierre
+   * avoid constant evaluation problems if cycling with -Cr
+
+  Revision 1.7  2002/02/04 21:41:15  michael
+  + merged ixed syntax
+
+  Revision 1.6  2002/02/04 21:29:34  michael
+  + merged missing sendto/rcvfrom functions
+
 }
 }

+ 19 - 1
rtl/win32/sockets.pp

@@ -44,6 +44,21 @@ begin
     SocketError:=0;
     SocketError:=0;
 end;
 end;
 
 
+Function CloseSocket(Sock:Longint):Longint;
+var i : longint;
+begin
+  i := Winsock.CloseSocket (Sock);
+  if i <> 0 then
+  begin
+    SocketError:=WSAGetLastError;
+    CloseSocket := i;
+  end else
+  begin
+    CloseSocket := 0;
+    SocketError := 0;
+  end;
+end;
+
 Function Send(Sock:Longint;Const Buf;BufLen,Flags:Longint):Longint;
 Function Send(Sock:Longint;Const Buf;BufLen,Flags:Longint):Longint;
 begin
 begin
   Send:=WinSock.Send(Sock,Buf,BufLen,Flags);
   Send:=WinSock.Send(Sock,Buf,BufLen,Flags);
@@ -245,7 +260,10 @@ finalization
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.10  2003-01-01 14:34:22  peter
+  Revision 1.11  2003-03-23 17:47:15  armin
+  * CloseSocket added
+
+  Revision 1.10  2003/01/01 14:34:22  peter
     * sendto overload
     * sendto overload
 
 
   Revision 1.9  2002/09/07 16:01:29  peter
   Revision 1.9  2002/09/07 16:01:29  peter