home *** CD-ROM | disk | FTP | other *** search
/ GEMini Atari / GEMini_Atari_CD-ROM_Walnut_Creek_December_1993.iso / files / program / m2posx02 / file.ipp < prev    next >
Text File  |  1993-10-23  |  28KB  |  1,142 lines
  1. IMPLEMENTATION MODULE file;
  2. (*__NO_CHECKS__*)
  3. (*****************************************************************************)
  4. (* Basiert auf der MiNTLIB von Eric R. Smith                                 *)
  5. (* --------------------------------------------------------------------------*)
  6. (* STATUS: OK                                                                *)
  7. (* --------------------------------------------------------------------------*)
  8. (* 12-Feb-93, Holger Kleinschmidt                                            *)
  9. (*****************************************************************************)
  10.  
  11. VAL_INTRINSIC
  12. CAST_IMPORT
  13. OSCALL_IMPORT
  14.  
  15. FROM SYSTEM IMPORT
  16. (* TYPE *) ADDRESS,
  17. (* PROC *) ADR;
  18.  
  19. FROM CTYPE IMPORT
  20. (* PROC *) TOUPPER, TOCARD;
  21.  
  22. FROM pSTRING IMPORT
  23. (* CONST*) EOS,
  24. (* PROC *) SLEN, APPEND;
  25.  
  26. FROM types IMPORT
  27. (* CONST*) DDRVPOSTFIX, DDIRSEP,
  28. (* TYPE *) SIGNEDWORD, UNSIGNEDWORD, SIGNEDLONG, UNSIGNEDLONG, WORDSET,
  29.            PathName, uidT, gidT, inoT, timeT, offT, sizeT, ssizeT, devT;
  30.  
  31. FROM err IMPORT
  32. (* CONST*) eOK, eFILNF,
  33.            EACCES, EFAULT, EEXIST, ENOSYS, EBADF, ENOENT, ESPIPE, EINVAL,
  34. (* VAR  *) errno;
  35.  
  36. FROM DosSystem IMPORT
  37. (* PROC *) DosVersion;
  38. #if MINT
  39. FROM DosSystem IMPORT MiNTVersion;
  40. #endif
  41.  
  42. FROM DosFile IMPORT
  43. (* CONST*) FINDALL,
  44. (* TYPE *) DTA, FileAttributes, FileAttribute,
  45. (* VAR  *) INODE,
  46. (* PROC *) IsDevice, IsDosDevice, UnixToDos, FindFirst, Seek, IsExec;
  47.  
  48. FROM sys IMPORT
  49. (* PROC *) time;
  50.  
  51. #include "oscalls.m2h"
  52.  
  53. (*==========================================================================*)
  54.  
  55. CONST
  56.   EOKL = LIC(0);
  57.  
  58.   BLKSIZE  = 1024;
  59.   LBLKSIZE = 256; (* BLKSIZE DIV 4 *)
  60.  
  61.   STDPERM = modeT{sIRUSR,sIWUSR,sIRGRP,sIWGRP,sIROTH,sIWOTH};
  62.  
  63. VAR
  64.   UMASK    : modeT;
  65.   zerofill : ARRAY [0..LBLKSIZE-1] OF UNSIGNEDLONG;
  66. #if MINT
  67.   MiNT     : CARDINAL;
  68. #endif
  69.  
  70. VAR
  71.   DOSVersion : CARDINAL;
  72.  
  73. (*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*)
  74.  
  75. PROCEDURE icreate (VAR path : PathName;
  76.                        mode : modeT;
  77.                    VAR hnd  : SIGNEDWORD;
  78.                    VAR done : BOOLEAN);
  79.  
  80. VAR lres : SIGNEDLONG;
  81.     wres : SIGNEDWORD;
  82.     attr : FileAttribute;
  83.  
  84. BEGIN
  85.  mode := mode - UMASK; (* schadet nix, wenn "MiNT" laeuft *)
  86.  IF sIWUSR IN mode THEN
  87.    attr := FileAttribute{};
  88.  ELSE
  89.    attr := FileAttribute{faRDONLY};
  90.  END;
  91.  Fcreate(ADR(path), CAST(UNSIGNEDWORD,attr), lres);
  92.  done := lres >= LIC(0);
  93.  hnd  := VAL(SIGNEDWORD,lres);
  94. #if MINT
  95.  IF done AND (MiNT >= 9) THEN
  96.    Fchmod(ADR(path), CAST(UNSIGNEDWORD,mode), wres);
  97.  END;
  98. #endif
  99. END icreate;
  100.  
  101. (*--------------------------------------------------------------------------*)
  102.  
  103. PROCEDURE iopen (VAR path : PathName;
  104.                      acc  : OpenMode;
  105.                  VAR hnd  : SIGNEDWORD;
  106.                  VAR done : BOOLEAN);
  107.  
  108. VAR lres : SIGNEDLONG;
  109.  
  110. BEGIN
  111.  acc := acc * oACCMODE; (* zur Zeit noch *)
  112.  Fopen(ADR(path), CAST(UNSIGNEDWORD,acc), lres);
  113.  done := lres >= LIC(0);;
  114.  hnd  := VAL(SIGNEDWORD,lres);
  115. END iopen;
  116.  
  117. (*--------------------------------------------------------------------------*)
  118.  
  119. PROCEDURE iclose (    h    : SIGNEDWORD;
  120.                   VAR err  : SIGNEDWORD;
  121.                   VAR done : BOOLEAN    );
  122.  
  123. VAR wres : SIGNEDWORD;
  124.  
  125. BEGIN
  126.  Fclose(h, wres);
  127.  err  := wres;
  128.  done := err = eOK;
  129. END iclose;
  130.  
  131. (*--------------------------------------------------------------------------*)
  132.  
  133. PROCEDURE idelete (VAR path : PathName;
  134.                    VAR err  : SIGNEDWORD;
  135.                    VAR done : BOOLEAN    );
  136.  
  137. VAR wres : SIGNEDWORD;
  138.  
  139. BEGIN
  140.  Fdelete(ADR(path), wres);
  141.  err  := wres;
  142.  done := err = eOK;
  143. END idelete;
  144.  
  145. (*--------------------------------------------------------------------------*)
  146.  
  147. PROCEDURE creat ((* EIN/ -- *) REF file : ARRAY OF CHAR;
  148.                  (* EIN/ -- *)     mode : modeT         ): INTEGER;
  149. (*T*)
  150. VAR wres   : SIGNEDWORD;
  151.     done   : BOOLEAN;
  152.     dot    : BOOLEAN;
  153.     attr   : FileAttribute;
  154.     path0  : PathName;
  155.  
  156. BEGIN
  157.  UnixToDos(file, path0, dot, done);
  158.  IF NOT done THEN
  159.    RETURN(MINHANDLE-1);
  160.  END;
  161.  
  162.  idelete(path0, wres, done);
  163.  IF (wres = eFILNF) OR (wres = eOK) THEN
  164.    icreate(path0, mode, wres, done);
  165.  END;
  166.  
  167.  IF done THEN
  168.    RETURN(INT(wres));
  169.  ELSE
  170.    errno := INT(wres);
  171.    RETURN(MINHANDLE-1);
  172.  END;
  173. END creat;
  174.  
  175. (*--------------------------------------------------------------------------*)
  176.  
  177. PROCEDURE open ((* EIN/ -- *) REF file   : ARRAY OF CHAR;
  178.                 (* EIN/ -- *)     access : OpenMode;
  179.                 (* EIN/ -- *)     mode   : modeT         ): INTEGER;
  180. (*T*)
  181. (*
  182.  Oeffne Datei
  183.  WENN Zugriffsmodus ungleich Nur-Lesen ODER Datei existiert noch nicht
  184.    WENN Datei erstellt werden soll
  185.      WENN Exclusiver-Zugriffsmodus UND Datei existiert
  186.        Datei schliessen, Fehler
  187.      ENDE
  188.    ODER WENN Datei nicht existiert
  189.      Fehler
  190.    ENDE
  191.    WENN      Datei gekuerzt werden soll UND Datei existiert (nicht Geraet)
  192.         ODER Datei bisher nicht existiert
  193.      WENN Datei existiert
  194.        Datei schliessen
  195.        Datei loeschen
  196.      ENDE
  197.      Datei mit entsprechenden Attributen neu anlegen
  198.      WENN Datei angelegt
  199.        Datei schliessen
  200.        Datei mit entsprechendem Zugriffsmodus oeffnen
  201.      ENDE
  202.    ENDE
  203.  ENDE
  204. *)
  205.  
  206. VAR wres   : SIGNEDWORD;
  207.     handle : SIGNEDWORD;
  208.     lres   : SIGNEDLONG;
  209.     dot    : BOOLEAN;
  210.     done   : BOOLEAN;
  211.     path0  : PathName;
  212.  
  213. BEGIN
  214.  UnixToDos(file, path0, dot, done);
  215.  IF NOT done THEN
  216.    RETURN(MINHANDLE-1);
  217.  END;
  218.  
  219.  iopen(path0, access, handle, done);
  220.  IF (access * oACCMODE <> oRDONLY) OR NOT done THEN
  221.    IF oCREAT IN access THEN
  222.      IF done AND (oEXCL IN access) THEN
  223.        iclose(handle, wres, done);
  224.        errno := EEXIST;
  225.        RETURN(MINHANDLE-1);
  226.      END;
  227.    ELSIF NOT done THEN
  228.      errno := INT(handle);
  229.      RETURN(MINHANDLE-1);
  230.    END;
  231.    IF (oTRUNC IN access) AND (handle >= 0) OR NOT done THEN
  232.      IF done THEN
  233.        iclose(handle, wres, done);
  234.        idelete(path0, wres, done);
  235.        IF done AND (oTRUNC IN access) AND (handle >= 0) THEN
  236.          (* Datei war schon vorhanden. Eigentlich sollten die
  237.           * alten Attribute uebernommen werden...
  238.           * Zumindest wird aber nicht das <mode>-Argument benutzt.
  239.           *)
  240.          Fcreate(ADR(path0), 0, lres);
  241.          done   := lres >= LIC(0);
  242.          handle := VAL(SIGNEDWORD,lres);
  243.        END;
  244.      ELSE
  245.        icreate(path0, mode, handle, done);
  246.      END;
  247.      IF done THEN
  248.        iclose(handle, wres, done);
  249.        iopen(path0, access, handle, done);
  250.      END;
  251.    END;
  252.  END;
  253.  
  254.  IF done THEN
  255.    RETURN(INT(handle));
  256.  ELSE
  257.    errno := INT(handle);
  258.    RETURN(MINHANDLE-1);
  259.  END;
  260. END open;
  261.  
  262. (*--------------------------------------------------------------------------*)
  263.  
  264. PROCEDURE close ((* EIN/ -- *) h : INTEGER ): INTEGER;
  265. (*T*)
  266. VAR wres : SIGNEDWORD;
  267.     done : BOOLEAN;
  268.  
  269. BEGIN
  270.  iclose(VAL(SIGNEDWORD,h), wres, done);
  271.  IF done THEN
  272.    RETURN(0);
  273.  ELSE
  274.    errno := INT(wres);
  275.    RETURN(-1);
  276.  END;
  277. END close;
  278.  
  279. (*--------------------------------------------------------------------------*)
  280.  
  281. PROCEDURE read ((* EIN/ -- *) h   : INTEGER;
  282.                 (* EIN/ -- *) buf : ADDRESS;
  283.                 (* EIN/ -- *) len : sizeT   ): ssizeT;
  284. (*T*)
  285. VAR lres : SIGNEDLONG;
  286.  
  287. BEGIN
  288.  Fread(VAL(SIGNEDWORD,h), VAL(SIGNEDLONG,len), buf, lres);
  289.  IF lres < EOKL THEN
  290.    errno := INT(lres);
  291.    RETURN(-1);
  292.  ELSE
  293.    RETURN(VAL(ssizeT,lres));
  294.  END;
  295. END read;
  296.  
  297. (*--------------------------------------------------------------------------*)
  298.  
  299. PROCEDURE write ((* EIN/ -- *) h   : INTEGER;
  300.                  (* EIN/ -- *) buf : ADDRESS;
  301.                  (* EIN/ -- *) len : sizeT   ): ssizeT;
  302. (*T*)
  303. VAR lres : SIGNEDLONG;
  304.  
  305. BEGIN
  306.  Fwrite(VAL(SIGNEDWORD,h), VAL(SIGNEDLONG,len), buf, lres);
  307.  IF lres < EOKL THEN
  308.    errno := INT(lres);
  309.    RETURN(-1);
  310.  ELSE
  311.    RETURN(VAL(ssizeT,lres));
  312.  END;
  313. END write;
  314.  
  315. (*--------------------------------------------------------------------------*)
  316.  
  317. PROCEDURE lseek ((* EIN/ -- *) h    : INTEGER;
  318.                  (* EIN/ -- *) off  : offT;
  319.                  (* EIN/ -- *) mode : SeekMode ): offT;
  320. (*T*)
  321. CONST ERANGEL = LIC(-64);
  322.       EACCDNL = LIC(-36);
  323.  
  324. VAR lres   : SIGNEDLONG;
  325.     curPos : SIGNEDLONG;
  326.     newPos : SIGNEDLONG;
  327.     len    : SIGNEDLONG;
  328.     done   : BOOLEAN;
  329.  
  330. BEGIN
  331.  len := VAL(SIGNEDLONG,off);
  332.  
  333.  IF len <= LIC(0) THEN
  334.    (* Datei braucht nicht verlaengert zu werden *)
  335.    Seek(h, len, ORD(mode), lres, done);
  336.    IF done THEN
  337.      RETURN(VAL(offT,lres));
  338. #if MINT
  339.    ELSIF (MiNT > 0) AND (lres = EACCDNL) THEN
  340.      errno := ESPIPE;
  341. #endif
  342.    ELSE
  343.      errno := INT(lres);
  344.    END;
  345.    RETURN(-1);
  346.  END;
  347.  
  348.  (* Augenblickliche Position feststellen, bei 'SeekEnd' gleich
  349.   * ans Ende der Datei.
  350.   *)
  351.  IF mode = SeekEnd THEN
  352.    Seek(h, 0, ORD(SeekEnd), curPos, done);
  353.  ELSE
  354.    Seek(h, 0, ORD(SeekCur), curPos, done);
  355.  END;
  356.  IF NOT done THEN
  357. #if MINT
  358.    IF (MiNT > 0) AND (curPos = EACCDNL) THEN
  359.      errno := ESPIPE;
  360.    ELSE
  361. #endif
  362.      errno := INT(curPos);
  363. #if MINT
  364.    END;
  365. #endif
  366.    RETURN(-1);
  367.  END;
  368.  
  369.  (* gewuenschte Position berechnen. 'SeekEnd' und 'SeekCur' koennen
  370.   * gleichbehandelt werden, da der Zeiger bei 'SeekEnd' schon am
  371.   * Ende der Datei steht.
  372.   *)
  373.  IF mode = SeekSet THEN
  374.    newPos := len;
  375.  ELSE
  376.    newPos := curPos + len;
  377.  END;
  378.  
  379.  (* Bei 'SeekCur' und 'SeekSet' kann es sein (ist auch meistens der Fall),
  380.   * dass die gewuenschte Position innerhalb der bestehenden Datei liegt.
  381.   * Deswegen wird zuerst versucht, die gewuenschte Position direkt
  382.   * anzufahren. Wenn dabei ein "Range-Fehler" auftritt, muss die Datei
  383.   * verlaengert werden.
  384.   *)
  385.  IF mode <> SeekEnd THEN
  386.    Seek(h, len, ORD(mode), curPos, done);
  387.    IF curPos = newPos THEN
  388.      RETURN(VAL(offT,curPos));
  389.    ELSIF NOT done AND (curPos <> ERANGEL) THEN
  390.      errno := INT(curPos);
  391.      RETURN(-1);
  392.    END;
  393.    Seek(h, 0, ORD(SeekEnd), curPos, done);
  394.  END;
  395.  
  396.  (* Solange Nullbytes schreiben, bis die Datei auf die gewuenschte
  397.   * Laenge gebracht ist.
  398.   *)
  399.  REPEAT
  400.    len := newPos - curPos;
  401.    IF  len > VAL(SIGNEDLONG,BLKSIZE)  THEN
  402.      len := VAL(SIGNEDLONG,BLKSIZE);
  403.    END;
  404.    Fwrite(VAL(SIGNEDWORD,h), len, ADR(zerofill), lres);
  405.    IF  lres <> len  THEN
  406.      IF lres >= EOKL  THEN
  407.        RETURN(VAL(offT,curPos + lres));
  408.      ELSE
  409.        errno := INT(lres);
  410.        RETURN(VAL(offT,curPos));
  411.      END;
  412.    END;
  413.    INC(curPos, len);
  414.  UNTIL curPos >= newPos;
  415.  RETURN(VAL(offT,curPos));
  416. END lseek;
  417.  
  418. (*--------------------------------------------------------------------------*)
  419.  
  420. PROCEDURE dup ((* EIN/ -- *) h : INTEGER ): INTEGER;
  421. (*T*)
  422. CONST FDUPFD = 0;
  423.  
  424. VAR lres : SIGNEDLONG;
  425.  
  426. BEGIN
  427. #if MINT
  428.  IF MiNT > 0 THEN
  429.    Fcntl(VAL(SIGNEDWORD,h), LIC(6), FDUPFD, lres);
  430.  ELSE
  431. #endif
  432.    Fdup(VAL(SIGNEDWORD,h), lres);
  433. #if MINT
  434.  END;
  435. #endif
  436.  IF lres < EOKL THEN
  437.    errno := INT(lres);
  438.    RETURN(-1);
  439.  ELSE
  440.    RETURN(INT(lres));
  441.  END;
  442. END dup;
  443.  
  444. (*--------------------------------------------------------------------------*)
  445.  
  446. PROCEDURE dup2 ((* EIN/ -- *) h  : INTEGER;
  447.                 (* EIN/ -- *) h2 : INTEGER ): INTEGER;
  448. (*T*)
  449. VAR wres : SIGNEDWORD;
  450.     done : BOOLEAN;
  451.  
  452. BEGIN
  453.  IF h = h2 THEN
  454.    RETURN(h2);
  455.  END;
  456.  (* Das Schliessen eines Standardkanals macht eine vorherige
  457.   * Umleitung rueckgaengig. Ist aber erst seit dem "GEMDOS" des TOS 1.04
  458.   * anwendbar.
  459.   *)
  460.  IF DOSVersion >= 1500H THEN
  461.    iclose(VAL(SIGNEDWORD,h2), wres, done);
  462.  END;
  463.  
  464.  Fforce(VAL(SIGNEDWORD,h2), VAL(SIGNEDWORD,h), wres);
  465.  IF wres < eOK THEN
  466.    errno := INT(wres);
  467.    RETURN(-1);
  468.  ELSE
  469.    RETURN(h2);
  470.  END;
  471. END dup2;
  472.  
  473. (*--------------------------------------------------------------------------*)
  474.  
  475. PROCEDURE isatty ((* EIN/ -- *) h : INTEGER ): BOOLEAN;
  476. (*T*)
  477. BEGIN
  478.  RETURN(IsDevice(h));
  479. END isatty;
  480.  
  481. (*--------------------------------------------------------------------------*)
  482.  
  483. PROCEDURE umask ((* EIN/ -- *) excl : modeT ): modeT;
  484. (*T*)
  485. VAR oldmask : modeT;
  486.     wres    : UNSIGNEDWORD;
  487.  
  488. BEGIN
  489.  oldmask := UMASK;
  490.  UMASK   := excl;
  491. #if MINT
  492.  IF MiNT >= 9 THEN
  493.    Pumask(CAST(UNSIGNEDWORD,excl), wres);
  494.    RETURN(CAST(modeT,wres));
  495.  ELSE
  496. #endif
  497.   RETURN(oldmask);
  498. #if MINT
  499.  END;
  500. #endif
  501. END umask;
  502.  
  503. (*---------------------------------------------------------------------------*)
  504.  
  505. PROCEDURE chmod ((* EIN/ -- *) REF file : ARRAY OF CHAR;
  506.                  (* EIN/ -- *)     mode : modeT         ): INTEGER;
  507. (*T*)
  508. CONST Set = 1;
  509.  
  510. VAR wres   : SIGNEDWORD;
  511.     err    : INTEGER;
  512.     dot    : BOOLEAN;
  513.     done   : BOOLEAN;
  514.     dta    : DTA;
  515.     attr   : FileAttribute;
  516.     path0  : PathName;
  517.  
  518. BEGIN
  519.  UnixToDos(file, path0, dot, done);
  520.  IF NOT done THEN
  521.    RETURN(-1);
  522.  END;
  523.  
  524. #if MINT
  525.  IF MiNT >= 9 THEN
  526.    Fchmod(ADR(path0), CAST(UNSIGNEDWORD,mode), wres);
  527.    IF wres < eOK THEN
  528.      errno := INT(wres);
  529.      RETURN(-1);
  530.    ELSE
  531.      RETURN(0);
  532.    END;
  533.  END;
  534. #endif
  535.  IF FindFirst(path0, FINDALL, dta, err) THEN
  536.    attr := dta.attr;
  537.    IF faSUBDIR IN attr THEN
  538.      (* Verzeichnisse in Ruhe lassen (duerfen keine weiteren Attribute haben)*)
  539.      RETURN(0);
  540.    END;
  541.    IF faCHANGED IN attr THEN
  542.      (* Archivbit nicht veraendern *)
  543.      attr := FileAttribute{faRDONLY, faCHANGED};
  544.    ELSE
  545.      attr := FileAttribute{faRDONLY};
  546.    END;
  547.    IF sIWUSR IN mode THEN
  548.      EXCL(attr, faRDONLY);
  549.    END;
  550.    Fattrib(ADR(path0), Set, CAST(UNSIGNEDWORD,attr), wres);
  551.    IF wres < eOK THEN
  552.      errno := INT(wres);
  553.      RETURN(-1);
  554.    ELSE
  555.      RETURN(0);
  556.    END;
  557.  ELSE
  558.    errno := err;
  559.    RETURN(-1);
  560.  END;
  561. END chmod;
  562.  
  563. (*--------------------------------------------------------------------------*)
  564.  
  565. PROCEDURE chown ((* EIN/ -- *) REF file : ARRAY OF CHAR;
  566.                  (* EIN/ -- *)     uid  : uidT;
  567.                  (* EIN/ -- *)     gid  : gidT          ): INTEGER;
  568. (*T*)
  569. #if MINT
  570. VAR wres   : SIGNEDWORD;
  571.     dot    : BOOLEAN;
  572.     done   : BOOLEAN;
  573.     path0  : PathName;
  574. #endif
  575. BEGIN
  576. #if MINT
  577.  IF MiNT >= 9 THEN
  578.    UnixToDos(file, path0, dot, done);
  579.    IF NOT done THEN
  580.      RETURN(-1);
  581.    END;
  582.  
  583.    Fchown(ADR(path0), VAL(UNSIGNEDWORD,uid), VAL(UNSIGNEDWORD,gid), wres);
  584.    IF wres < eOK THEN
  585.      errno := INT(wres);
  586.      RETURN(-1);
  587.    ELSE
  588.      RETURN(0);
  589.    END;
  590.  END;
  591. #endif
  592.  IF (uid <> 0) OR (gid <> 0) THEN
  593.    errno := EINVAL;
  594.    RETURN(-1);
  595.  ELSE
  596.    RETURN(0);
  597.  END;
  598. END chown;
  599.  
  600. (*--------------------------------------------------------------------------*)
  601.  
  602. PROCEDURE utime ((* EIN/ -- *) REF file  : ARRAY OF CHAR;
  603.                  (* EIN/ -- *)     times : UTimeBuf      ): INTEGER;
  604. (*T*)
  605. VAR datime : timeT;
  606.     wres   : SIGNEDWORD;
  607.     dot    : BOOLEAN;
  608.     done   : BOOLEAN;
  609.     path0  : PathName;
  610.  
  611. BEGIN
  612.  UnixToDos(file, path0, dot, done);
  613.  IF NOT done THEN
  614.    RETURN(-1);
  615.  END;
  616.  
  617.  WITH times DO
  618.    IF modtime.cmp = LC(0) THEN
  619.      time(modtime);
  620.    END;
  621.    datime.date := modtime.time;
  622.    datime.time := modtime.date;
  623.  END;
  624.  iopen(path0, oRDWR, wres, done);
  625.  IF done THEN
  626.    Fdatime(ADR(datime), wres, 1);
  627.    iclose(wres, wres, done);
  628.  END;
  629.  IF done THEN
  630.    RETURN(0);
  631.  ELSE
  632.    errno := INT(wres);
  633.    RETURN(-1);
  634.  END;
  635. END utime;
  636.  
  637. (*---------------------------------------------------------------------------*)
  638.  
  639. PROCEDURE pipe ((* -- /AUS *) VAR ph : PipeBuf ): INTEGER;
  640. (**)
  641. #if MINT
  642. VAR handle : ARRAY [0..1] OF SIGNEDWORD;
  643.     wres   : SIGNEDWORD;
  644. #endif
  645. BEGIN
  646.  ph.readh  := 0;
  647.  ph.writeh := 0;
  648. #if MINT
  649.  IF MiNT > 0 THEN
  650.    Fpipe(ADR(handle), wres);
  651.    IF wres < eOK THEN
  652.      errno := INT(wres);
  653.      RETURN(-1);
  654.    ELSE
  655.      ph.readh  := handle[0];
  656.      ph.writeh := handle[1];
  657.      RETURN(0);
  658.    END;
  659.  END;
  660. #endif
  661.  errno := ENOSYS;
  662.  RETURN(-1);
  663. END pipe;
  664.  
  665. (*---------------------------------------------------------------------------*)
  666. #if MINT
  667. PROCEDURE MiNTstat (    hndl : BOOLEAN;
  668.                         sym  : BOOLEAN;
  669.                         h    : INTEGER;
  670.                     VAR path : ARRAY OF CHAR;
  671.                     VAR st   : StatRec       ): INTEGER;
  672. (*T*)
  673. CONST
  674.   FSTAT = 00004600H;
  675.  
  676. VAR
  677.   lres  : SIGNEDLONG;
  678.   xattr : RECORD
  679.     mode    : modeT;
  680.     index   : UNSIGNEDLONG;
  681.     dev     : UNSIGNEDWORD;
  682.     res1    : UNSIGNEDWORD;
  683.     nlink   : UNSIGNEDWORD;
  684.     uid     : UNSIGNEDWORD;
  685.     gid     : UNSIGNEDWORD;
  686.     size    : SIGNEDLONG;
  687.     blksize : SIGNEDLONG;
  688.     nblocks : SIGNEDLONG;
  689.     mtime   : WORDSET;
  690.     mdate   : WORDSET;
  691.     atime   : WORDSET;
  692.     adate   : WORDSET;
  693.     ctime   : WORDSET;
  694.     cdate   : WORDSET;
  695.     attr    : WORDSET;
  696.     res2    : SIGNEDWORD;
  697.     res3    : ARRAY [0..1] OF SIGNEDLONG;
  698.   END;
  699.  
  700. BEGIN
  701.  IF hndl THEN
  702.    Fcntl(VAL(SIGNEDWORD,h), ADR(xattr), FSTAT, lres);
  703.  ELSE
  704.    Fxattr(VAL(UNSIGNEDWORD,sym), ADR(path), ADR(xattr), lres);
  705.  END;
  706.  IF lres < EOKL THEN
  707.    errno := INT(lres);
  708.    RETURN(-1);
  709.  END;
  710.  
  711.  WITH st DO
  712.  WITH xattr DO
  713.    stMode       := mode;
  714.    stIno        := index;
  715.    stDev        := dev;
  716.    stNlink      := nlink;
  717.    stUid        := uid;
  718.    stGid        := gid;
  719.    stSize       := size;
  720.    stMtime.time := mtime;
  721.    stMtime.date := mdate;
  722.    stAtime.time := atime;
  723.    stAtime.date := adate;
  724.    stCtime.time := ctime;
  725.    stCtime.date := cdate;
  726.  END;
  727.  END;
  728.  RETURN(0);
  729. END MiNTstat;
  730.  
  731. (*--------------------------------------------------------------------------*)
  732. #endif
  733.  
  734. #if has_REF
  735. PROCEDURE istat (REF name : ARRAY OF CHAR;
  736. #else
  737. PROCEDURE istat (VAR name : ARRAY OF CHAR;
  738. #endif
  739.                  VAR st   : StatRec;
  740.                      sym  : BOOLEAN       ): INTEGER;
  741. (*T*)
  742. CONST DIRSIZE = 1024;
  743.  
  744. VAR dta      : DTA;
  745.     drive    : UNSIGNEDWORD;
  746.     date     : UNSIGNEDWORD;
  747.     err      : INTEGER;
  748.     wres     : SIGNEDWORD;
  749.     pLen     : CARDINAL;
  750.     path0    : PathName;
  751.     c        : CHAR;
  752.     ROOT     : BOOLEAN;
  753.     DOT      : BOOLEAN;
  754.     drv      : BOOLEAN;
  755. #if MINT
  756.     spcdrv   : BOOLEAN;
  757. #endif
  758.  
  759. BEGIN
  760.  UnixToDos(name, path0, DOT, drv);
  761.  IF NOT drv THEN
  762.    RETURN(-1);
  763.  END;
  764.  
  765. #if MINT
  766.  IF MiNT >= 9 THEN
  767.    RETURN(MiNTstat(FALSE, sym, 0, path0, st));
  768.  END;
  769. #endif
  770.  pLen := SLEN(path0);
  771.  
  772.  st.stUid := 0;
  773.  st.stGid := 0;
  774.  
  775.  IF IsDosDevice(path0) THEN
  776.    WITH st DO
  777.      stIno        := VAL(inoT,INODE); INC(INODE);
  778.      stMode       := sIFCHR + STDPERM;
  779.      stDev        := 0;
  780.      Tgettime(date);
  781.      stMtime.time := CAST(WORDSET,date);
  782.      Tgetdate(date);
  783.      stMtime.date := CAST(WORDSET,date);
  784.      stAtime.cmp  := stMtime.cmp;
  785.      stCtime.cmp  := stMtime.cmp;
  786.      stNlink      := 1;
  787.      stSize       := 0;
  788.    END;
  789.    RETURN(0);
  790.  END;
  791.  
  792.  IF path0[1] = DDRVPOSTFIX THEN
  793.    st.stDev := VAL(devT,TOCARD(path0[0]) - 10);
  794.    drv      := TRUE;
  795.  ELSE
  796.    Dgetdrv(drive);
  797.    st.stDev := VAL(devT,drive);
  798.    drv      := FALSE;
  799.  END;
  800.  c := path0[0];
  801.  
  802.  (* Hauptverzeichnisse muessen gesondert behandelt werden, da sie nicht
  803.   * wie Unterverzeichnisse in der Baumstruktur eingebunden sind - sie
  804.   * haben kein Erstellungsdatum und besitzen nicht die Eintraege
  805.   * "." und ".." zur Verkettung.
  806.   *)
  807.  IF            (pLen = 1) AND (c = DDIRSEP)
  808.     OR drv AND (pLen = 3) AND (path0[2] = DDIRSEP)
  809.  THEN
  810.    (* Ein Hauptverzeichnis ist direkt angegeben, deshalb sind keine
  811.     * weiteren Tests noetig.
  812.     *)
  813.    ROOT := TRUE;
  814.  ELSE
  815.    IF path0[pLen-1] = DDIRSEP THEN
  816.      (* Verzeichnisse nicht extra kennzeichnen.
  817.       * 'pLen' ist mindestens zwei, da der Fall 'pLen' = 1
  818.       * oben abgefangen wird.
  819.       *)
  820.      path0[pLen-1] := EOS;
  821.      DEC(pLen);
  822.    ELSIF drv AND (pLen = 2) THEN
  823.      (* "Fsfirst("x:")" funktioniert nicht *)
  824.      path0[2] := '.';
  825.      path0[3] := EOS;
  826.      DOT      := TRUE;
  827.    END;
  828.  
  829.    IF DOT THEN
  830.      APPEND("\*.*", path0);
  831.      (* Den ersten Eintrag suchen, sodass bei allen Verzeichnissen - ausser
  832.       * den Hauptverzeichnissen - der Eintrag "." gefunden wird.
  833.       * (Bei "..\*.*" wird das "." des uebergeordneten Verzeichnisses
  834.       * gefunden.)
  835.       *)
  836.    END;
  837.  
  838.    IF FindFirst(path0, FINDALL, dta, err) THEN
  839.      ROOT := DOT AND ((dta.name[0] <> '.') OR (dta.name[1] <> 0C));
  840.      (* nicht-leeres Hauptverzeichnis, falls der erste Eintrag nicht
  841.       * mit einem Punkt beginnt (normaler Dateiname), oder nach dem Punkt
  842.       * nicht beendet ist (dann kann es nicht "." sein, das in allen
  843.       * Verzeichnissen zuerst steht.
  844.       *)
  845.    ELSE
  846.      (* Wenn kein Eintrag gefunden wird und "." oder ".." angegeben
  847.       * wurden, handelt es sich um ein leeres Hauptverzeichnis,
  848.       * ansonsten ist ein Fehler aufgetreten (angegebene Datei wurde
  849.       * nicht gefunden).
  850.       *)
  851.      IF DOT AND (err = eFILNF) THEN
  852.        ROOT := TRUE;
  853.      ELSE
  854.        errno := err;
  855.        RETURN(-1);
  856.      END;
  857.    END;
  858.  END;
  859.  
  860.  IF ROOT THEN
  861.    (* Einem Hauptverzeichnis lassen sich leider kaum Informationen
  862.     * entlocken.
  863.     *)
  864.    WITH st DO
  865.      stIno       := 2;
  866.      stSize      := DIRSIZE;
  867.      stNlink     := 2;
  868.      stMode      := sIFDIR + STDPERM + modeT{sIXUSR, sIXGRP, sIXOTH};
  869.      stMtime.cmp := 0;
  870.      stAtime.cmp := 0;
  871.      stCtime.cmp := 0;
  872.    END;
  873.    RETURN(0);
  874.  END;
  875.  
  876.  WITH st DO
  877.    stIno        := VAL(inoT,INODE); INC(INODE);
  878.    stMtime.date := dta.date;
  879.    stMtime.time := dta.time;
  880.    stAtime      := stMtime;
  881.    stCtime      := stMtime;
  882.    IF faSUBDIR IN dta.attr THEN
  883.      stSize  := DIRSIZE;
  884.      stNlink := 2;
  885.    ELSE
  886.      stSize  := dta.size;
  887.      stNlink := 1;
  888.    END;
  889.  
  890. #if MINT
  891.    IF MiNT > 0 THEN
  892.      spcdrv := TRUE;
  893.      IF stDev = 16 (*Q:\xxx*) THEN
  894.        stMode := sIFIFO + STDPERM;
  895.      ELSIF stDev = 21 (*V:\xxx*) THEN
  896.        stMode := sIFCHR + STDPERM;
  897.      ELSIF stDev = 23 (*X:\xxx*) THEN
  898.        stMode := modeT{Type14, Type15, sIRUSR, sIWUSR};
  899.      ELSE
  900.        spcdrv := FALSE;
  901.      END;
  902.    ELSE
  903.      spcdrv := FALSE;
  904.    END;
  905.    IF NOT spcdrv THEN
  906. #endif
  907.      IF faSUBDIR IN dta.attr THEN
  908.        stMode := sIFDIR + STDPERM + modeT{sIXUSR, sIXGRP, sIXOTH};
  909.      ELSIF IsExec(path0) THEN
  910.        stMode := sIFREG + STDPERM + modeT{sIXUSR, sIXGRP, sIXOTH};
  911.      ELSE
  912.        stMode := sIFREG + STDPERM;
  913.      END;
  914. #if MINT
  915.    END;
  916. #endif
  917.    IF faRDONLY IN dta.attr THEN
  918.      stMode := stMode - modeT{sIWUSR, sIWGRP, sIWOTH};
  919.    END;
  920.  END; (* WITH st *)
  921.  RETURN(0);
  922. END istat;
  923.  
  924. (*--------------------------------------------------------------------------*)
  925.  
  926. PROCEDURE stat ((* EIN/ -- *) REF file : ARRAY OF CHAR;
  927.                 (* -- /AUS *) VAR st   : StatRec       ): INTEGER;
  928. (*T*)
  929. BEGIN
  930.  RETURN(istat(file, st, FALSE));
  931. END stat;
  932.  
  933. (*--------------------------------------------------------------------------*)
  934.  
  935. PROCEDURE lstat ((* EIN/ -- *) REF file : ARRAY OF CHAR;
  936.                  (* -- /AUS *) VAR st   : StatRec       ): INTEGER;
  937. (*T*)
  938. BEGIN
  939.  RETURN(istat(file, st, TRUE));
  940. END lstat;
  941.  
  942. (*--------------------------------------------------------------------------*)
  943.  
  944. PROCEDURE fstat ((* EIN/ -- *)     hndl : INTEGER;
  945.                  (* -- /AUS *) VAR st   : StatRec  ): INTEGER;
  946. (*T*)
  947. #if MINT
  948. CONST
  949.   EACCDNL = LIC(-36);
  950.   FIFOSIZE = 1024;
  951. #endif
  952. VAR drive  : UNSIGNEDWORD;
  953.     date   : UNSIGNEDWORD;
  954.     err    : INTEGER;
  955.     pos    : SIGNEDLONG;
  956.     size   : SIGNEDLONG;
  957.     done   : BOOLEAN;
  958.     time   : ARRAY [0..1] OF WORDSET;
  959.     lres   : SIGNEDLONG;
  960.     magic  : UNSIGNEDWORD;
  961.     dummy  : ARRAY [0..0] OF CHAR;
  962.  
  963. BEGIN
  964. #if MINT
  965.  IF MiNT >= 9 THEN
  966.    RETURN(MiNTstat(TRUE, FALSE, hndl, dummy, st));
  967.  END;
  968. #endif
  969.  WITH st DO
  970.    IF IsDevice(hndl) THEN
  971.      stMode       := sIFCHR + STDPERM;
  972.      stSize       := 0;
  973.      Tgettime(date);
  974.      stMtime.time := CAST(WORDSET,date);
  975.      Tgetdate(date);
  976.      stMtime.date := CAST(WORDSET,date);
  977.      stAtime.cmp  := stMtime.cmp;
  978.      stCtime.cmp  := stMtime.cmp;
  979.    ELSE
  980.      Fdatime(ADR(time), VAL(SIGNEDWORD,hndl), 0);
  981.      stMtime.time := time[0];
  982.      stMtime.date := time[1];
  983.      stAtime.cmp  := stMtime.cmp;
  984.      stCtime.cmp  := stMtime.cmp;
  985.  
  986.      Seek(hndl, 0, ORD(SeekCur), pos, done);
  987.      IF done THEN
  988.        Seek(hndl, 0, ORD(SeekEnd), size, done);
  989.        stSize := size;
  990.  
  991.        Seek(hndl, 0, ORD(SeekSet), size, done);
  992.        Fread(VAL(SIGNEDWORD,hndl), LC(2), ADR(magic), lres);
  993.        IF (lres = LIC(2)) AND ((magic = 601AH) OR (magic = 2321H))(* #! *) THEN
  994.          stMode := sIFREG + STDPERM + modeT{sIXUSR, sIXGRP, sIXOTH};
  995.        ELSE
  996.          stMode := sIFREG + STDPERM;
  997.        END;
  998.        Seek(hndl, pos, ORD(SeekSet), size, done);
  999. #if MINT
  1000.      ELSIF (MiNT > 0) AND (pos = EACCDNL) THEN
  1001.        stSize := FIFOSIZE;
  1002.        stMode := sIFIFO + STDPERM;
  1003. #endif
  1004.      ELSE
  1005.        errno := EBADF;
  1006.        RETURN(-1);
  1007.      END;
  1008.    END;
  1009.  
  1010.    Dgetdrv(drive);
  1011.    stUid   := 0;
  1012.    stGid   := 0;
  1013.    stDev   := VAL(devT,drive);
  1014.    stNlink := 1;
  1015.    stIno   := VAL(inoT,INODE); INC(INODE);
  1016.  END; (* WITH *)
  1017.  RETURN(0);
  1018. END fstat;
  1019.  
  1020. (*--------------------------------------------------------------------------*)
  1021.  
  1022. PROCEDURE sISCHR ((* EIN/ -- *) stMode : modeT ): BOOLEAN;
  1023. BEGIN
  1024.  RETURN(stMode * sIFMT = sIFCHR);
  1025. END sISCHR;
  1026.  
  1027. (*--------------------------------------------------------------------------*)
  1028.  
  1029. PROCEDURE sISDIR ((* EIN/ -- *) stMode : modeT ): BOOLEAN;
  1030. BEGIN
  1031.  RETURN(stMode * sIFMT = sIFDIR);
  1032. END sISDIR;
  1033.  
  1034. (*--------------------------------------------------------------------------*)
  1035.  
  1036. PROCEDURE sISBLK ((* EIN/ -- *) stMode : modeT ): BOOLEAN;
  1037. BEGIN
  1038.  RETURN(stMode * sIFMT = sIFBLK);
  1039. END sISBLK;
  1040.  
  1041. (*--------------------------------------------------------------------------*)
  1042.  
  1043. PROCEDURE sISREG ((* EIN/ -- *) stMode : modeT ): BOOLEAN;
  1044. BEGIN
  1045.  RETURN(stMode * sIFMT = sIFREG);
  1046. END sISREG;
  1047.  
  1048. (*--------------------------------------------------------------------------*)
  1049.  
  1050. PROCEDURE sISFIFO ((* EIN/ -- *) stMode : modeT ): BOOLEAN;
  1051. BEGIN
  1052.  RETURN(stMode * sIFMT = sIFIFO);
  1053. END sISFIFO;
  1054.  
  1055. (*--------------------------------------------------------------------------*)
  1056.  
  1057. PROCEDURE sISLNK ((* EIN/ -- *) stMode : modeT ): BOOLEAN;
  1058. BEGIN
  1059.  RETURN(stMode * sIFMT = sIFLNK);
  1060. END sISLNK;
  1061.  
  1062. (*--------------------------------------------------------------------------*)
  1063.  
  1064. PROCEDURE access ((* EIN/ -- *) REF file : ARRAY OF CHAR;
  1065.                   (* EIN/ -- *)     acc  : AccessMode    ): INTEGER;
  1066. (*T*)
  1067. VAR dta  : DTA;
  1068.     st   : StatRec;
  1069. #if MINT
  1070.     wres : UNSIGNEDWORD;
  1071. #endif
  1072.  
  1073. BEGIN
  1074.  IF istat(file, st, FALSE) < 0 THEN
  1075.    RETURN(-1);
  1076.  ELSIF acc = fOK THEN
  1077.    RETURN(0);
  1078.  END;
  1079.  
  1080. #if MINT
  1081.  IF MiNT > 0 THEN
  1082.    Pgetuid(wres);
  1083.  END;
  1084.  IF (MiNT < 9) OR (VAL(uidT,wres) = st.stUid) THEN
  1085. #endif
  1086.    IF acc <= CAST(AccessMode,VAL(UNSIGNEDWORD,
  1087.                CAST(UNSIGNEDWORD,st.stMode * sIRWXU) DIV 64))
  1088.    THEN
  1089.      RETURN(0);
  1090.    ELSE
  1091.      errno := EACCES;
  1092.      RETURN(-1);
  1093.    END;
  1094. #if MINT
  1095.  END;
  1096.  
  1097.  Pgetgid(wres);
  1098.  IF VAL(gidT,wres) = st.stGid THEN
  1099.    IF acc <= CAST(AccessMode,VAL(UNSIGNEDWORD,
  1100.                CAST(UNSIGNEDWORD,st.stMode * sIRWXG) DIV 8))
  1101.    THEN
  1102.      RETURN(0);
  1103.    ELSE
  1104.      errno := EACCES;
  1105.      RETURN(-1);
  1106.    END;
  1107.  END;
  1108.  
  1109.  IF acc <= CAST(AccessMode,st.stMode * sIRWXO) THEN
  1110.    RETURN(0);
  1111.  ELSE
  1112.    errno := EACCES;
  1113.    RETURN(-1);
  1114.  END;
  1115. #endif
  1116. END access;
  1117.  
  1118. (*==========================================================================*)
  1119.  
  1120. VAR
  1121.   i : UNSIGNEDWORD;
  1122.  
  1123. BEGIN (* file *)
  1124.  FOR i := 0 TO LBLKSIZE - 1 DO
  1125.    zerofill[i] := 0;
  1126.  END;
  1127.  
  1128.  DOSVersion := DosVersion();
  1129. #if MINT
  1130.  MiNT := MiNTVersion();
  1131.  IF MiNT >= 9 THEN
  1132.    Pumask(0, i);
  1133.    UMASK := CAST(modeT,i);
  1134.    Pumask(CAST(UNSIGNEDWORD,UMASK), i);
  1135.  ELSE
  1136. #endif
  1137.    UMASK := modeT{};
  1138. #if MINT
  1139.  END;
  1140. #endif
  1141. END file.
  1142.