Browse Source

+ added MorphOS specific sockets.pp (WIP, but already works at some level)
+ added sockets unit to Makefile.fpc (i have no recent fpcmake ATM to regenerate Makefile)

git-svn-id: trunk@8149 -

Károly Balogh 18 năm trước cách đây
mục cha
commit
5f33a865a7
3 tập tin đã thay đổi với 319 bổ sung2 xóa
  1. 1 0
      .gitattributes
  2. 7 2
      rtl/morphos/Makefile.fpc
  3. 311 0
      rtl/morphos/sockets.pp

+ 1 - 0
.gitattributes

@@ -4887,6 +4887,7 @@ rtl/morphos/mouse.pp svneol=native#text/plain
 rtl/morphos/mui.pas -text
 rtl/morphos/muihelper.pas -text
 rtl/morphos/prt0.as -text
+rtl/morphos/sockets.pp svneol=native#text/plain
 rtl/morphos/sysdir.inc svneol=native#text/plain
 rtl/morphos/sysfile.inc svneol=native#text/plain
 rtl/morphos/sysheap.inc svneol=native#text/plain

+ 7 - 2
rtl/morphos/Makefile.fpc

@@ -8,14 +8,14 @@ main=rtl
 [target]
 loaders=prt0
 units=$(SYSTEMUNIT) objpas macpas strings \
-      dos heaptrc \
+      dos heaptrc ctypes \
       sysutils classes fgl strutils math typinfo varutils \
       charset ucomplex getopts matrix fmtbcd \
       variants types rtlconsts sysconst dateutil objects \
       exec timer doslib utility hardware inputevent keymap graphics layers \
       intuition aboxlib mui \
 # these units are here, because they depend on system interface units above
-      kvm video keyboard mouse \
+      kvm video keyboard mouse sockets \
 # these can be moved to packages later
       clipboard datatypes asl ahi tinygl get9 muihelper
 rsts=math rtlconsts varutils typinfo variants classes sysconst dateutil
@@ -237,3 +237,8 @@ mouse$(PPUEXT) : mouse.pp
 
 keyboard$(PPUEXT) : keyboard.pp 
 #windows$(PPUEXT) dos$(PPUEXT) winevent$(PPUEXT)
+
+ctypes$(PPUEXT) :  $(INC)/ctypes.pp $(SYSTEMUNIT)$(PPUEXT)
+
+sockets$(PPUEXT) : sockets.pp $(INC)/textrec.inc $(INC)/filerec.inc \
+                   ctypes$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)

+ 311 - 0
rtl/morphos/sockets.pp

@@ -0,0 +1,311 @@
+{
+    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;
+
+
+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 legacy SocketBase 030;
+function bsd_bind(s : LongInt location 'd0'; const name : psockaddr location 'a0'; namelen : LongInt location 'd1') : LongInt; syscall legacy SocketBase 036;
+function bsd_listen(s : LongInt location 'd0'; backlog : LongInt location 'd1') : LongInt; syscall legacy SocketBase 042;
+function bsd_accept(s : LongInt location 'd0'; addr : psockaddr location 'a0'; var addrlen : LongInt location 'a1') : LongInt; syscall legacy SocketBase 048;
+function bsd_connect(s : LongInt location 'd0'; const name : psockaddr location 'a0'; namelen : LongInt location 'd1') : LongInt; syscall legacy SocketBase 054;
+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 legacy SocketBase 060;
+function bsd_send(s : LongInt location 'd0'; const msg : pChar location 'a0'; len : LongInt location 'd1'; flags : LongInt location 'd2') : LongInt; syscall legacy SocketBase 066;
+function bsd_recvfrom(s : LongInt location 'd0'; buf : pChar location 'a0'; len : LongInt location 'd1'; flags : LongInt location 'd2'; from : psockaddr location 'a1'; var fromlen : LongInt location 'a2') : LongInt; syscall legacy SocketBase 072;
+function bsd_recv(s : LongInt location 'd0'; buf : pChar location 'a0'; len : LongInt location 'd1'; flags : LongInt location 'd2') : LongInt; syscall legacy SocketBase 078;
+function bsd_shutdown(s : LongInt location 'd0'; how : LongInt location 'd1') : LongInt; syscall legacy SocketBase 084;
+function bsd_closesocket(d : LongInt location 'd0') : LongInt; syscall legacy SocketBase 120;
+function bsd_inet_ntoa(in_ : DWord location 'd0') : pChar; syscall legacy SocketBase 174;
+function bsd_inet_addr(const cp : pChar location 'a0') : DWord; syscall legacy SocketBase 180;
+function bsd_gethostbyname(const name : pChar location 'a0') : phostent; syscall legacy SocketBase 210;
+function bsd_gethostbyaddr(const addr : pChar location 'a0'; len : LongInt location 'd0'; type_ : LongInt location 'd1') : phostent; syscall legacy SocketBase 216;
+
+
+Implementation
+
+//Uses {$ifndef FPC_USE_LIBC}SysCall{$else}initc{$endif};
+
+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;
+
+//{$define uselibc:=cdecl; external;}
+
+//const libname='c';
+{
+function cfpaccept      (s:cint; addrx : psockaddr; addrlen : psocklen):cint; cdecl; external libname name 'accept';
+function cfpbind        (s:cint; addrx : psockaddr; addrlen : tsocklen):cint;  cdecl; external libname name 'bind';
+function cfpconnect     (s:cint; name  : psockaddr; namelen : tsocklen):cint;  cdecl; external libname name 'connect';
+function cfpgetpeername (s:cint; name  : psockaddr; namelen : psocklen):cint; cdecl; external libname name 'getpeername';
+function cfpgetsockname (s:cint; name  : psockaddr; namelen : psocklen):cint; cdecl; external libname name 'getsockname';
+function cfpgetsockopt  (s:cint; level:cint; optname:cint; optval:pointer; optlen : psocklen):cint; cdecl; external libname name 'getsockopt';
+function cfplisten      (s:cint; backlog : cint):cint;                          cdecl; external libname name 'listen';
+function cfprecv        (s:cint; buf: pointer; len: size_t; flags: cint):ssize_t; cdecl; external libname name 'recv';
+function cfprecvfrom    (s:cint; buf: pointer; len: size_t; flags: cint; from : psockaddr; fromlen : psocklen):ssize_t; cdecl; external libname name 'recvfrom';
+//function cfprecvmsg     (s:cint; msg: pmsghdr; flags:cint):ssize_t; cdecl; external libname name '';
+function cfpsend        (s:cint; msg:pointer; len:size_t; flags:cint):ssize_t; cdecl; external libname name 'send';
+function cfpsendto      (s:cint; msg:pointer; len:size_t; flags:cint; tox :psockaddr; tolen: tsocklen):ssize_t; cdecl; external libname name 'sendto';
+//function cfpsendmsg   (s:cint; hdr: pmsghdr; flags:cint):ssize; cdecl; external libname name '';
+function cfpsetsockopt  (s:cint; level:cint; optname:cint; optval:pointer; optlen :tsocklen):cint; cdecl; external libname name 'setsockopt';
+function cfpshutdown    (s:cint; how:cint):cint; cdecl; external libname name 'shutdown';
+function cfpsocket      (domain:cint; xtype:cint; protocol: cint):cint; cdecl; external libname name 'socket';
+function cfpsocketpair  (d:cint; xtype:cint; protocol:cint; sv:pcint):cint; cdecl; external libname name 'socketpair';
+}
+
+function cfpaccept(s : LongInt location 'd0'; addr : psockaddr location 'a0';  addrlen : pSocklen location 'a1') : LongInt; syscall legacy SocketBase 048;
+function cfpbind(s : LongInt location 'd0'; const name : psockaddr location 'a0'; namelen : LongInt location 'd1') : LongInt; syscall legacy SocketBase 036;
+function cfpconnect(s : LongInt location 'd0'; const name : psockaddr location 'a0'; namelen : LongInt location 'd1') : LongInt; syscall legacy SocketBase 054;
+function cfpsendto(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 legacy SocketBase 060;
+function cfpsend(s : LongInt location 'd0'; const msg : pChar location 'a0'; len : LongInt location 'd1'; flags : LongInt location 'd2') : LongInt; syscall legacy SocketBase 066;
+function cfprecvfrom(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 legacy SocketBase 072;
+function cfprecv(s : LongInt location 'd0'; buf : pChar location 'a0'; len : LongInt location 'd1'; flags : LongInt location 'd2') : LongInt; syscall legacy SocketBase 078;
+function cfpgetsockopt(s : LongInt location 'd0'; level : LongInt location 'd1'; optname : LongInt location 'd2'; optval : Pointer location 'a0'; optlen : pSockLen location 'a1') : LongInt; syscall legacy SocketBase 096;
+function cfpgetsockname(s : LongInt location 'd0'; hostname : psockaddr location 'a0'; namelen : pSockLen location 'a1') : LongInt; syscall legacy SocketBase 102;
+function cfpgetpeername(s : LongInt location 'd0'; hostname : psockaddr location 'a0'; namelen : pSockLen location 'a1') : LongInt; syscall legacy SocketBase 108;
+function cfpsetsockopt(s : LongInt location 'd0'; level : LongInt location 'd1'; optname : LongInt location 'd2'; const optval : Pointer location 'a0'; optlen : LongInt location 'd3') : LongInt; syscall legacy SocketBase 090;
+function cfplisten(s : LongInt location 'd0'; backlog : LongInt location 'd1') : LongInt; syscall legacy SocketBase 042;
+function cfpsocket(domain : LongInt location 'd0'; type_ : LongInt location 'd1'; protocol : LongInt location 'd2') : LongInt; syscall legacy SocketBase 030;
+function cfpshutdown(s : LongInt location 'd0'; how : LongInt location 'd1') : LongInt; syscall legacy SocketBase 084;
+function cfpCloseSocket(d : LongInt location 'd0') : LongInt; syscall legacy SocketBase 120;
+
+function cfpErrno : LongInt; syscall legacy SocketBase 162;
+
+function fpgeterrno: longint; inline;
+begin
+  fpgeterrno:=cfpErrno;
+end;
+
+function fpClose(d: LongInt): LongInt; inline;
+begin
+  fpClose:=cfpCloseSocket(d);
+end;
+
+function fpaccept      (s:cint; addrx : psockaddr; addrlen : psocklen):cint;
+
+begin
+ fpaccept:=cfpaccept(s,addrx,addrlen);
+ internal_socketerror:=fpgeterrno; 
+end;
+
+function fpbind (s:cint; addrx : psockaddr; addrlen : tsocklen):cint;
+begin
+  fpbind:=cfpbind (s,addrx,addrlen);
+  internal_socketerror:=fpgeterrno;
+end;
+
+function fpconnect     (s:cint; name  : psockaddr; namelen : tsocklen):cint;
+begin
+  fpconnect:=cfpconnect (s,name,namelen);
+  internal_socketerror:=fpgeterrno;
+end;
+
+function fpgetpeername (s:cint; name  : psockaddr; namelen : psocklen):cint;
+begin
+  fpgetpeername:=cfpgetpeername (s,name,namelen);
+  internal_socketerror:=fpgeterrno;
+end;
+
+function fpgetsockname (s:cint; name  : psockaddr; namelen : psocklen):cint;
+begin
+  fpgetsockname:=cfpgetsockname(s,name,namelen);
+  internal_socketerror:=fpgeterrno;
+end;
+
+function fpgetsockopt  (s:cint; level:cint; optname:cint; optval:pointer; optlen : psocklen):cint;
+begin
+  fpgetsockopt:=cfpgetsockopt(s,level,optname,optval,optlen);
+  internal_socketerror:=fpgeterrno;
+end;
+
+function fplisten      (s:cint; backlog : cint):cint;
+begin
+  fplisten:=cfplisten(s,backlog);
+  internal_socketerror:=fpgeterrno;
+end;
+
+function fprecv         (s:cint; buf: pointer; len: size_t; flags:cint):ssize_t;
+begin
+  fprecv:= cfprecv      (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:= cfprecvfrom (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:=cfpsend (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:=cfpsendto (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:=cfpsetsockopt(s,level,optname,optval,optlen);
+  internal_socketerror:=fpgeterrno;
+end;
+
+function fpshutdown     (s:cint; how:cint):cint;
+begin
+  fpshutdown:=cfpshutdown(s,how);
+  internal_socketerror:=fpgeterrno;
+end;
+
+function fpsocket       (domain:cint; xtype:cint; protocol: cint):cint;
+begin
+  fpsocket:=cfpsocket(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:=NIL;
+  SocketBase:=OpenLibrary('bsdsocket.library',4);
+
+finalization
+
+  if (SocketBase<>NIL) then CloseLibrary(SocketBase);
+
+end.