gcc/m2/gm2-libs-iso/ClientSocket.mod

   1 (* ClientSocket.mod provides a client TCP interface for ChanId's.
   2
   3 Copyright (C) 2008-2024 Free Software Foundation, Inc.
   4 Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
   5
   6 This file is part of GNU Modula-2.
   7
   8 GNU Modula-2 is free software; you can redistribute it and/or modify
   9 it under the terms of the GNU General Public License as published by
  10 the Free Software Foundation; either version 3, or (at your option)
  11 any later version.
  12
  13 GNU Modula-2 is distributed in the hope that it will be useful, but
  14 WITHOUT ANY WARRANTY; without even the implied warranty of
  15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  16 General Public License for more details.
  17
  18 Under Section 7 of GPL version 3, you are granted additional
  19 permissions described in the GCC Runtime Library Exception, version
  20 3.1, as published by the Free Software Foundation.
  21
  22 You should have received a copy of the GNU General Public License and
  23 a copy of the GCC Runtime Library Exception along with this program;
  24 see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
  25 <http://www.gnu.org/licenses/>.  *)
  26
  27 IMPLEMENTATION MODULE ClientSocket ;
  28
  29
  30 FROM ASCII IMPORT nul, lf, cr ;
  31 FROM ChanConsts IMPORT ChanFlags ;
  32 FROM RTio IMPORT GetDeviceId ;
  33 FROM RTgenif IMPORT GenDevIF, InitGenDevIF ;
  34 FROM RTdata IMPORT ModuleId, MakeModuleId, InitData, GetData, KillData ;
  35 FROM IOChan IMPORT ChanExceptions, InvalidChan, CurrentFlags ;
  36 FROM IOConsts IMPORT ReadResults ;
  37
  38 FROM IOLink IMPORT DeviceId, DeviceTable, DeviceTablePtr, DeviceTablePtrValue, IsDevice,
  39                    AllocateDeviceId, RAISEdevException, MakeChan, UnMakeChan ;
  40
  41 FROM Storage IMPORT ALLOCATE, DEALLOCATE ;
  42 FROM Strings IMPORT Append ;
  43 FROM SYSTEM IMPORT ADDRESS, ADR, LOC ;
  44 FROM libc IMPORT read, write, close ;
  45 FROM errno IMPORT geterrno ;
  46 FROM ErrnoCategory IMPORT GetOpenResults ;
  47 FROM WholeStr IMPORT IntToStr ;
  48
  49 FROM RTgen IMPORT ChanDev, DeviceType, InitChanDev,
  50                   doLook, doSkip, doSkipLook, doWriteLn,
  51                   doReadText, doWriteText, doReadLocs, doWriteLocs,
  52                   checkErrno ;
  53
  54 FROM wrapsock IMPORT clientInfo, clientOpen, clientOpenIP, getClientPortNo,
  55                      getClientSocketFd, getClientIP, getSizeOfClientInfo,
  56                      getPushBackChar, setPushBackChar, getClientHostname ;
  57
  58
  59 TYPE
  60    PtrToLoc   = POINTER TO LOC ;
  61    ClientInfo = ADDRESS ;
  62 VAR
  63    mid           : ModuleId ;
  64    did           : DeviceId ;
  65    dev           : ChanDev ;
  66    ClientInfoSize: CARDINAL ;
  67
  68
  69 PROCEDURE look (d: DeviceTablePtr;
  70                 VAR ch: CHAR; VAR r: ReadResults) ;
  71 BEGIN
  72    doLook(dev, d, ch, r)
  73 END look ;
  74
  75
  76 PROCEDURE skip (d: DeviceTablePtr) ;
  77 BEGIN
  78    doSkip(dev, d)
  79 END skip ;
  80
  81
  82 PROCEDURE skiplook (d: DeviceTablePtr;
  83                     VAR ch: CHAR; VAR r: ReadResults) ;
  84 BEGIN
  85    doSkipLook(dev, d, ch, r)
  86 END skiplook ;
  87
  88
  89 PROCEDURE lnwrite (d: DeviceTablePtr) ;
  90 BEGIN
  91    doWriteLn(dev, d)
  92 END lnwrite ;
  93
  94
  95 PROCEDURE textread (d: DeviceTablePtr;
  96                     to: ADDRESS;
  97                     maxChars: CARDINAL;
  98                     VAR charsRead: CARDINAL) ;
  99 BEGIN
 100    doReadText(dev, d, to, maxChars, charsRead)
 101 END textread ;
 102
 103
 104 PROCEDURE textwrite (d: DeviceTablePtr;
 105                      from: ADDRESS;
 106                      charsToWrite: CARDINAL);
 107 BEGIN
 108    doWriteText(dev, d, from, charsToWrite)
 109 END textwrite ;
 110
 111
 112 PROCEDURE rawread (d: DeviceTablePtr;
 113                    to: ADDRESS;
 114                    maxLocs: CARDINAL;
 115                    VAR locsRead: CARDINAL) ;
 116 BEGIN
 117    doReadLocs(dev, d, to, maxLocs, locsRead)
 118 END rawread ;
 119
 120
 121 PROCEDURE rawwrite (d: DeviceTablePtr;
 122                     from: ADDRESS;
 123                     locsToWrite: CARDINAL) ;
 124 BEGIN
 125    doWriteLocs(dev, d, from, locsToWrite)
 126 END rawwrite ;
 127
 128
 129 (*
 130    doreadchar - returns a CHAR from the file associated with, g.
 131 *)
 132
 133 PROCEDURE doreadchar (g: GenDevIF; d: DeviceTablePtr) : CHAR ;
 134 VAR
 135    i : INTEGER ;
 136    fd: INTEGER ;
 137    c : ClientInfo ;
 138    ch: CHAR ;
 139 BEGIN
 140    c := GetData(d, mid) ;
 141    WITH d^ DO
 142       fd := getClientSocketFd(c) ;
 143       IF NOT getPushBackChar(c, ch)
 144       THEN
 145          REPEAT
 146             i := read(fd, ADR(ch), SIZE(ch))
 147          UNTIL i#0 ;
 148          IF i<0
 149          THEN
 150             errNum := geterrno()
 151          END
 152       END ;
 153       RETURN( ch )
 154    END
 155 END doreadchar ;
 156
 157
 158 (*
 159    dounreadchar - pushes a CHAR back onto the file associated with, g.
 160 *)
 161
 162 PROCEDURE dounreadchar (g: GenDevIF; d: DeviceTablePtr; ch: CHAR) : CHAR ;
 163 VAR
 164    fd: INTEGER ;
 165    c : ClientInfo ;
 166 BEGIN
 167    c := GetData(d, mid) ;
 168    WITH d^ DO
 169       fd := getClientSocketFd(c) ;
 170       IF NOT setPushBackChar(c, ch)
 171       THEN
 172          RAISEdevException(cid, did, notAvailable,
 173                            'ClientSocket.dounreadchar: number of characters pushed back exceeds buffer')
 174       END ;
 175       RETURN( ch )
 176    END
 177 END dounreadchar ;
 178
 179
 180 (*
 181    dogeterrno - returns the errno relating to the generic device.
 182 *)
 183
 184 PROCEDURE dogeterrno (g: GenDevIF; d: DeviceTablePtr) : INTEGER ;
 185 BEGIN
 186    RETURN geterrno()
 187 END dogeterrno ;
 188
 189
 190 (*
 191    dorbytes - reads upto, max, bytes setting, actual, and
 192               returning FALSE if an error (not due to eof)
 193               occurred.
 194 *)
 195
 196 PROCEDURE dorbytes (g: GenDevIF; d: DeviceTablePtr;
 197                     to: ADDRESS;
 198                     max: CARDINAL;
 199                     VAR actual: CARDINAL) : BOOLEAN ;
 200 VAR
 201    fd: INTEGER ;
 202    c : ClientInfo ;
 203    p : PtrToLoc ;
 204    i : INTEGER ;
 205 BEGIN
 206    c := GetData(d, mid) ;
 207    WITH d^ DO
 208       IF max>0
 209       THEN
 210          p := to ;
 211          IF getPushBackChar(c, p^)
 212          THEN
 213             actual := 1 ;
 214             RETURN( TRUE )
 215          END ;
 216          fd := getClientSocketFd(c) ;
 217          i := read(fd, p, max) ;
 218          IF i>=0
 219          THEN
 220             actual := i ;
 221             RETURN( TRUE )
 222          ELSE
 223             errNum := geterrno() ;
 224             actual := 0 ;
 225             RETURN( FALSE )
 226          END
 227       ELSE
 228          RETURN( FALSE )
 229       END
 230    END
 231 END dorbytes ;
 232
 233
 234 (*
 235    dowbytes - attempts to write out nBytes.  The actual
 236               number of bytes written are returned.
 237               If the actual number of bytes written is >= 0 then
 238               the return result will be true.  Failure to
 239               write any bytes results in returning FALSE
 240               errno set and the actual will be set to zero.
 241 *)
 242
 243 PROCEDURE dowbytes (g: GenDevIF; d: DeviceTablePtr;
 244                     from: ADDRESS;
 245                     nBytes: CARDINAL;
 246                     VAR actual: CARDINAL) : BOOLEAN ;
 247 VAR
 248    fd: INTEGER ;
 249    c : ClientInfo ;
 250    i : INTEGER ;
 251 BEGIN
 252    c := GetData(d, mid) ;
 253    WITH d^ DO
 254       fd := getClientSocketFd(c) ;
 255       i := write(fd, from, nBytes) ;
 256       IF i>=0
 257       THEN
 258          actual := i ;
 259          RETURN( TRUE )
 260       ELSE
 261          errNum := geterrno() ;
 262          actual := 0 ;
 263          RETURN( FALSE )
 264       END
 265    END
 266 END dowbytes ;
 267
 268
 269 (*
 270    dowriteln - attempt to write an end of line marker to the
 271                file and returns TRUE if successful.
 272 *)
 273
 274 PROCEDURE dowriteln (g: GenDevIF; d: DeviceTablePtr) : BOOLEAN ;
 275 VAR
 276    a: ARRAY [0..1] OF CHAR ;
 277    i: CARDINAL ;
 278 BEGIN
 279    a[0] := cr ;
 280    a[1] := lf ;
 281    RETURN( dowbytes(g, d, ADR(a), SIZE(a), i) AND (i=SIZE(a)) )
 282 END dowriteln ;
 283
 284
 285 (*
 286    iseof - returns TRUE if end of file is seen.
 287 *)
 288
 289 PROCEDURE iseof (g: GenDevIF; d: DeviceTablePtr) : BOOLEAN ;
 290 VAR
 291    ch: CHAR ;
 292 BEGIN
 293    ch := doreadchar(g, d) ;
 294    WITH d^ DO
 295       IF errNum=0
 296       THEN
 297          ch := dounreadchar(g, d, ch) ;
 298          RETURN( FALSE )
 299       ELSE
 300          RETURN( TRUE )
 301       END
 302    END
 303 END iseof ;
 304
 305
 306 (*
 307    iseoln - returns TRUE if end of line is seen.
 308 *)
 309
 310 PROCEDURE iseoln (g: GenDevIF; d: DeviceTablePtr) : BOOLEAN ;
 311 VAR
 312    ch: CHAR ;
 313 BEGIN
 314    ch := doreadchar(g, d) ;
 315    WITH d^ DO
 316       IF errNum=0
 317       THEN
 318          ch := dounreadchar(g, d, ch) ;
 319          RETURN( ch=lf )
 320       ELSE
 321          RETURN( FALSE )
 322       END
 323    END
 324 END iseoln ;
 325
 326
 327 (*
 328    iserror - returns TRUE if an error was seen on the device.
 329 *)
 330
 331 PROCEDURE iserror (g: GenDevIF; d: DeviceTablePtr) : BOOLEAN ;
 332 BEGIN
 333    RETURN( d^.errNum#0 )
 334 END iserror ;
 335
 336
 337 PROCEDURE getname (d: DeviceTablePtr;
 338                    VAR a: ARRAY OF CHAR) ;
 339 VAR
 340    c: ClientInfo ;
 341    b: ARRAY [0..6] OF CHAR ;
 342 BEGIN
 343    c := GetData(d, mid) ;
 344    getClientHostname(c, ADR(a), HIGH(a)) ;
 345    Append(':', a) ;
 346    IntToStr(getClientPortNo(c) , b) ;
 347    Append(b, a)
 348 END getname ;
 349
 350
 351 (*
 352    freeData - disposes of, c.
 353 *)
 354
 355 PROCEDURE freeData (c: ClientInfo) ;
 356 BEGIN
 357    DEALLOCATE(c, ClientInfoSize) ;
 358 END freeData ;
 359
 360
 361 (*
 362    handlefree -
 363 *)
 364
 365 PROCEDURE handlefree (d: DeviceTablePtr) ;
 366 VAR
 367    c : ClientInfo ;
 368    fd: INTEGER ;
 369    i : INTEGER ;
 370 BEGIN
 371    c := GetData(d, mid) ;
 372    fd := getClientSocketFd(c) ;
 373    i := close(fd) ;
 374    checkErrno(dev, d) ;
 375    KillData(d, mid)
 376 END handlefree ;
 377
 378
 379 (*
 380    OpenSocket - opens a TCP client connection to host:port.
 381 *)
 382
 383 PROCEDURE OpenSocket (VAR cid: ChanId;
 384                       host: ARRAY OF CHAR; port: CARDINAL;
 385                       f: FlagSet; VAR res: OpenResults) ;
 386 VAR
 387    d: DeviceTablePtr ;
 388    c: ClientInfo ;
 389    e: INTEGER ;
 390 BEGIN
 391    MakeChan(did, cid) ;              (* create new channel *)
 392    ALLOCATE(c, ClientInfoSize) ;     (* allocate client socket memory *)
 393    d := DeviceTablePtrValue(cid, did) ;
 394    InitData(d, mid, c, freeData) ;   (* attach memory to device and module *)
 395    res := clientOpen(c, ADR(host), LENGTH(host), port) ;
 396    IF res=opened
 397    THEN
 398       e := 0
 399    ELSE
 400       e := geterrno()
 401    END ;
 402    WITH d^ DO
 403       flags := f ;
 404       errNum := e ;
 405       doLook := look ;
 406       doSkip := skip ;
 407       doSkipLook := skiplook ;
 408       doLnWrite := lnwrite ;
 409       doTextRead := textread ;
 410       doTextWrite := textwrite ;
 411       doRawRead := rawread ;
 412       doRawWrite := rawwrite ;
 413       doGetName := getname ;
 414       doFree := handlefree
 415    END
 416 END OpenSocket ;
 417
 418
 419 (*
 420    IsSocket - tests if the channel identified by cid is open as
 421               a client socket stream.
 422 *)
 423
 424 PROCEDURE IsSocket (cid: ChanId) : BOOLEAN ;
 425 BEGIN
 426    RETURN( (cid # NIL) AND (InvalidChan() # cid) AND
 427            (IsDevice(cid, did)) AND
 428            ((readFlag IN CurrentFlags(cid)) OR
 429             (writeFlag IN CurrentFlags(cid))) )
 430 END IsSocket ;
 431
 432
 433 (*
 434    Close - if the channel identified by cid is not open to a socket
 435            stream, the exception wrongDevice is raised; otherwise
 436            closes the channel, and assigns the value identifying
 437            the invalid channel to cid.
 438 *)
 439
 440 PROCEDURE Close (VAR cid: ChanId) ;
 441 BEGIN
 442    IF IsSocket(cid)
 443    THEN
 444       UnMakeChan(did, cid) ;
 445       cid := InvalidChan()
 446    ELSE
 447       RAISEdevException(cid, did, wrongDevice,
 448                         'ClientSocket.' + __FUNCTION__ +
 449                         ': channel is not a socket stream')
 450    END
 451 END Close ;
 452
 453
 454 (*
 455    Init -
 456 *)
 457
 458 PROCEDURE Init ;
 459 VAR
 460    gen: GenDevIF ;
 461 BEGIN
 462    MakeModuleId(mid) ;
 463    ClientInfoSize := getSizeOfClientInfo() ;
 464    AllocateDeviceId(did) ;
 465    gen := InitGenDevIF(did, doreadchar, dounreadchar,
 466                        dogeterrno, dorbytes, dowbytes,
 467                        dowriteln,
 468                        iseof, iseoln, iserror) ;
 469    dev := InitChanDev(streamfile, did, gen)
 470 END Init ;
 471
 472
 473 BEGIN
 474    Init
 475 END ClientSocket.