"Fossies" - the Fresh Open Source Software Archive

Member "seed7/lib/ar.s7i" (28 Jul 2020, 37171 Bytes) of package /linux/misc/seed7_05_20210223.tgz:


As a special service "Fossies" has tried to format the requested text file into HTML format (style: standard) with prefixed line numbers. Alternatively you can here view or download the uninterpreted source code file. See also the last Fossies "Diffs" side-by-side code changes report for "ar.s7i": 05_20200727_vs_05_20200830.

    1 
    2 (********************************************************************)
    3 (*                                                                  *)
    4 (*  ar.s7i        Ar archive library                                *)
    5 (*  Copyright (C) 2019, 2020  Thomas Mertes                         *)
    6 (*                                                                  *)
    7 (*  This file is part of the Seed7 Runtime Library.                 *)
    8 (*                                                                  *)
    9 (*  The Seed7 Runtime Library is free software; you can             *)
   10 (*  redistribute it and/or modify it under the terms of the GNU     *)
   11 (*  Lesser General Public License as published by the Free Software *)
   12 (*  Foundation; either version 2.1 of the License, or (at your      *)
   13 (*  option) any later version.                                      *)
   14 (*                                                                  *)
   15 (*  The Seed7 Runtime Library is distributed in the hope that it    *)
   16 (*  will be useful, but WITHOUT ANY WARRANTY; without even the      *)
   17 (*  implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR *)
   18 (*  PURPOSE.  See the GNU Lesser General Public License for more    *)
   19 (*  details.                                                        *)
   20 (*                                                                  *)
   21 (*  You should have received a copy of the GNU Lesser General       *)
   22 (*  Public License along with this program; if not, write to the    *)
   23 (*  Free Software Foundation, Inc., 51 Franklin Street,             *)
   24 (*  Fifth Floor, Boston, MA  02110-1301, USA.                       *)
   25 (*                                                                  *)
   26 (********************************************************************)
   27 
   28 
   29 include "stdio.s7i";
   30 include "time.s7i";
   31 include "filesys.s7i";
   32 include "filebits.s7i";
   33 include "unicode.s7i";
   34 include "fileutil.s7i";
   35 include "subfile.s7i";
   36 include "iobuffer.s7i";
   37 
   38 
   39 const string: AR_MAGIC is "!<arch>\n";
   40 
   41 const integer: AR_HEADER_SIZE      is 60;
   42 
   43 const integer: AR_PADDING is 2;
   44 
   45 
   46 const type: arHeader is new struct
   47     var string: name is "";
   48     var integer: mtime is 0;
   49     var integer: ownerId is 0;
   50     var integer: groupId is 0;
   51     var integer: mode is 0;
   52     var integer: fileSize is 0;
   53     var boolean: okay is FALSE;
   54     # A longNameStart of zero means: The filePath is in header.name.
   55     # Values greater than zero indicate an index into ar.longNames.
   56     # Note that longNameStart is one more than the value used in the file.
   57     var integer: longNameStart is 0;
   58     var string: filePath is "";
   59     var integer: dataStartPos is 0;
   60   end struct;
   61 
   62 
   63 const proc: showHeader (inout file: outFile, in arHeader: header) is func
   64   begin
   65     writeln(outFile, "name: " <& header.name);
   66     writeln(outFile, "mtime: " <& header.mtime);
   67     writeln(outFile, "ownerId: " <& header.ownerId);
   68     writeln(outFile, "groupId: " <& header.groupId);
   69     writeln(outFile, "mode: " <& header.mode);
   70     writeln(outFile, "fileSize: " <& header.fileSize);
   71     writeln(outFile, "okay: " <& header.okay);
   72     writeln(outFile, "longNameStart: " <& header.longNameStart);
   73     writeln(outFile, "filePath: " <& header.filePath);
   74     writeln(outFile, "dataStartPos: " <& header.dataStartPos);
   75   end func;
   76 
   77 
   78 const proc: assignFilePath (inout arHeader: header, in string: stri) is func
   79   local
   80     var integer: slashPos is 0;
   81   begin
   82     header.longNameStart := 0;
   83     slashPos := rpos(stri, '/', 16);
   84     # writeln("slashPos: " <& slashPos);
   85     if slashPos = 0 then
   86       header.name := rtrim(stri[ .. 16]);
   87     elsif slashPos = 1 then
   88       if stri[2] >= '0' and stri[2] <= '9' then
   89         header.longNameStart := succ(integer(rtrim(stri[2 .. 16])));
   90         header.name := "";
   91       else
   92         header.name := "/";
   93       end if;
   94     elsif slashPos = 2 and stri[1] = '/' then
   95       header.name := "//";
   96     else
   97       header.name := stri[ .. pred(slashPos)];
   98     end if;
   99     if header.name <> "" then
  100       block
  101         header.filePath := utf8ToStri(header.name);
  102       exception
  103         catch RANGE_ERROR:
  104           header.filePath := header.name;
  105       end block;
  106     else
  107       header.filePath := "";
  108     end if;
  109   end func;
  110 
  111 
  112 const func arHeader: arHeader (in string: stri) is func
  113   result
  114     var arHeader: header is arHeader.value;
  115   begin
  116     assignFilePath(header, stri);
  117     if stri[17 .. 48] <> " " mult 32 then
  118       header.mtime :=   integer(rtrim(stri[17 len 12]));
  119       header.ownerId := integer(rtrim(stri[29 len  6]));
  120       header.groupId := integer(rtrim(stri[35 len  6]));
  121       header.mode :=    integer(rtrim(stri[41 len  8]));
  122     end if;
  123     header.fileSize :=           integer(rtrim(stri[49 len 10]));
  124     header.okay :=                             stri[59 len  2] = "`\n";
  125   end func;
  126 
  127 
  128 const proc: readHead (inout file: inFile, inout arHeader: header) is func
  129   local
  130     var string: stri is "";
  131   begin
  132     stri := gets(inFile, AR_HEADER_SIZE);
  133     if length(stri) = AR_HEADER_SIZE then
  134       # writeln(literal(stri));
  135       header := arHeader(stri);
  136       header.dataStartPos := tell(inFile);
  137     else
  138       header := arHeader.value;
  139     end if;
  140     # showHeader(OUT, header);
  141   end func;
  142 
  143 
  144 const proc: readMinimumOfHead (inout file: inFile, inout arHeader: header) is func
  145   local
  146     var string: stri is "";
  147   begin
  148     stri := gets(inFile, AR_HEADER_SIZE);
  149     if length(stri) = AR_HEADER_SIZE then
  150       assignFilePath(header, stri);
  151       header.fileSize :=       integer(rtrim(stri[49 len 10]));
  152       header.okay :=                         stri[59 len  2] = "`\n";
  153     else
  154       header := arHeader.value;
  155     end if;
  156     # showHeader(OUT, header);
  157   end func;
  158 
  159 
  160 const func string: str (in arHeader: header) is func
  161   result
  162     var string: stri is "";
  163   local
  164     var string: filePath8 is "";
  165   begin
  166     filePath8 := striToUtf8(header.filePath);
  167     # writeln("filePath8: " <& literal(filePath8));
  168     if header.longNameStart = 0 then
  169       if length(filePath8) < 16 then
  170         stri := (filePath8 & "/") rpad 16;
  171       elsif length(filePath8) = 16 then
  172         stri := filePath8[.. 16];
  173       else
  174         raise RANGE_ERROR;
  175       end if;
  176     else
  177       stri := "/" <& pred(header.longNameStart) rpad 15;
  178     end if;
  179     stri &:= header.mtime rpad 12 <&
  180              header.ownerId rpad 6 <&
  181              header.groupId rpad 6 <&
  182              header.mode rpad 8 <&
  183              header.fileSize rpad 10 <&
  184              "`\n";
  185     # writeln("header string: " <& literal(stri));
  186   end func;
  187 
  188 
  189 const proc: writeHead (inout file: outFile, in arHeader: header) is func
  190   begin
  191     write(outFile, str(header));
  192   end func;
  193 
  194 
  195 const func string: getLongName (in string: longNames, in integer: longNameStart) is func
  196   result
  197     var string: longName is "";
  198   local
  199     var string: longName8 is "";
  200     var integer: nlPos is 0;
  201     var integer: slashPos is 0;
  202   begin
  203     nlPos := pos(longNames, '\n', longNameStart);
  204     if nlPos <> 0 then
  205       longName8 := longNames[longNameStart .. pred(nlPos)];
  206     else
  207       longName8 := longNames[longNameStart ..];
  208     end if;
  209     slashPos := rpos(longName8, '/');
  210     if slashPos <> 0 then
  211       longName8 := longName8[ .. pred(slashPos)];
  212     end if;
  213     block
  214       longName := utf8ToStri(longName8);
  215     exception
  216       catch RANGE_ERROR:
  217         longName := longName8;
  218     end block;
  219   end func;
  220 
  221 
  222 const func integer: addLongName (inout string: longNames, in string: longName) is func
  223   result
  224     var integer: longNameStart is 0;
  225   local
  226     var integer: nameListEnd is 0;
  227   begin
  228     longNameStart := pos(longNames, longName & "/");
  229     if longNameStart <> 0 and
  230         longNameStart + length(longName) > length(longNames) and
  231         longNames[longNameStart + length(longName) + 1] <> '\n' then
  232       # longName is not stored correctly in longNames.
  233       longNameStart := 0;
  234     end if;
  235     if longNameStart = 0 then
  236       nameListEnd := length(longNames);
  237       while nameListEnd >= 1 and longNames[nameListEnd] = '\n' do
  238         decr(nameListEnd);
  239       end while;
  240       if nameListEnd = 0 then
  241         longNames := longName & "/\n";
  242         longNameStart := 1;
  243       else
  244         longNames := longNames[.. nameListEnd] & "\n" & longName & "/\n";
  245         longNameStart := nameListEnd + 2;
  246       end if;
  247       if odd(length(longNames)) then
  248         # Add padding
  249         longNames &:= "\n";
  250       end if;
  251     end if;
  252   end func;
  253 
  254 
  255 const type: arRegisterType is hash [string] integer;
  256 const type: arCatalogType is hash [string] arHeader;
  257 
  258 
  259 (**
  260  *  [[filesys#fileSys|FileSys]] implementation type to access an AR archive.
  261  *  File paths in an AR archive can be absolute (they start with a slash)
  262  *  or relative (they do not start with a slash). The ar file system does
  263  *  not support the concept of a current working directory. The functions
  264  *  chdir and getcwd are not supported by the ar file system. Absolute
  265  *  and relative paths in an AR archive can be accessed directly.
  266  *  Since "/" is just a normal path in an AR archive the root path of a
  267  *  ar file system is "". Possible usages of ar file system functions are:
  268  *    getMTime(aArFile, "src/drivers")   # Relative path in the archive.
  269  *    fileType(aArFile, "/usr/include")  # Absolute path in the archive.
  270  *    fileSize(aArFile, "/image")        # Absolute path in the archive.
  271  *    readDir(aArFile, "")               # Return e.g.: "src" and "/"
  272  *    readDir(aArFile, "/")              # Return e.g.: "usr" and "image"
  273  *)
  274 const type: arArchive is sub emptyFileSys struct
  275     var file: arFile is STD_NULL;
  276     var integer: longNamesHeaderPos is 0;
  277     var string: longNames is "";
  278     var arRegisterType: register is arRegisterType.value;
  279     var arCatalogType: catalog is arCatalogType.value;
  280   end struct;
  281 
  282 
  283 (**
  284  *  Open an AR archive with the given arFile.
  285  *  @param arFile File that contains an AR archive.
  286  *  @return a file system that accesses the AR archive.
  287  *)
  288 const func fileSys: openAr (inout file: arFile) is func
  289   result
  290     var fileSys: newFileSys is fileSys.value;
  291   local
  292     var string: magic is "";
  293     var arHeader: header is arHeader.value;
  294     var integer: headerPos is 1;
  295     var arArchive: ar is arArchive.value;
  296   begin
  297     if length(arFile) = 0 then
  298       ar.arFile := arFile;
  299       newFileSys := toInterface(ar);
  300     else
  301       seek(arFile, headerPos);
  302       magic := gets(arFile, length(AR_MAGIC));
  303       if magic = AR_MAGIC then
  304         ar.arFile := arFile;
  305         headerPos := tell(arFile);
  306         readMinimumOfHead(arFile, header);
  307         while header.okay do
  308           # writeln(header.filePath <& " " <& headerPos);
  309           if header.filePath = "//" then
  310             # showHeader(OUT, header);
  311             ar.longNamesHeaderPos := headerPos;
  312             ar.longNames := gets(arFile, header.fileSize);
  313             # writeln("long Names: " <& literal(ar.longNames));
  314             headerPos := tell(arFile);
  315           elsif header.filePath = "/" then
  316             # showHeader(OUT, header);
  317             # lookup table
  318             ignore(gets(arFile, header.fileSize));
  319             headerPos := tell(arFile);
  320           else
  321             if header.longNameStart <> 0 then
  322               header.filePath := getLongName(ar.longNames, header.longNameStart);
  323             end if;
  324             # showHeader(OUT, header);
  325             ar.register @:= [header.filePath] headerPos;
  326             if header.fileSize = 0 then
  327               headerPos := tell(arFile);
  328             else
  329               headerPos := tell(arFile) +
  330                   succ(pred(header.fileSize) mdiv AR_PADDING) * AR_PADDING;
  331               seek(arFile, headerPos);
  332             end if;
  333           end if;
  334           readMinimumOfHead(arFile, header);
  335         end while;
  336         newFileSys := toInterface(ar);
  337       end if;
  338     end if;
  339   end func;
  340 
  341 
  342 (**
  343  *  Open an AR archive with the given arFileName.
  344  *  @param arFileName Name of the AR archive to be opened.
  345  *  @return a file system that accesses the AR archive.
  346  *)
  347 const func fileSys: openAr (in string: arFileName) is func
  348   result
  349     var fileSys: ar is fileSys.value;
  350   local
  351     var file: arFile is STD_NULL;
  352   begin
  353     arFile := open(arFileName, "r");
  354     ar := openAr(arFile);
  355   end func;
  356 
  357 
  358 (**
  359  *  Close an AR archive.
  360  *)
  361 const proc: close (inout arArchive: ar) is func
  362   begin
  363     close(ar.arFile);
  364     ar.arFile := STD_NULL;
  365   end func;
  366 
  367 
  368 const func arHeader: addToCatalog (inout arArchive: ar, in string: filePath) is func
  369   result
  370     var arHeader: header is arHeader.value;
  371   local
  372     var string: linkPath is "";
  373   begin
  374     seek(ar.arFile, ar.register[filePath]);
  375     readHead(ar.arFile, header);
  376     ar.catalog @:= [filePath] header;
  377   end func;
  378 
  379 
  380 const func boolean: implicitDir (inout arArchive: ar, in string: dirPath) is func
  381   result
  382     var boolean: implicitDir is FALSE;
  383   local
  384     var string: filePath is "";
  385   begin
  386     # writeln("implicitDir: " <& literal(dirPath));
  387     if dirPath <> "" then
  388       for key filePath range ar.register do
  389         if startsWith(filePath, dirPath) and
  390             length(filePath) > length(dirPath) and
  391             (filePath[succ(length(dirPath))] = '/' or dirPath = "/") then
  392           implicitDir := TRUE;
  393         end if;
  394       end for;
  395     end if;
  396   end func;
  397 
  398 
  399 const func arHeader: addImplicitDir (inout arArchive: ar,
  400     in string: dirPath) is func
  401   result
  402     var arHeader: header is arHeader.value;
  403   begin
  404     header.filePath := dirPath;
  405     header.mode := ord(MODE_FILE_DIR) + 8#775;
  406     header.dataStartPos := -1;
  407     ar.catalog @:= [dirPath] header;
  408   end func;
  409 
  410 
  411 const proc: fixRegisterAndCatalog (inout arArchive: ar, in integer: insertPos,
  412     in integer: numChars) is func
  413   local
  414     var integer: headerPos is 1;
  415     var string: filePath is "";
  416   begin
  417     for key filePath range ar.register do
  418       if ar.register[filePath] >= insertPos then
  419         ar.register[filePath] +:= numChars;
  420       end if;
  421     end for;
  422     for key filePath range ar.catalog do
  423       if ar.catalog[filePath].dataStartPos >= insertPos then
  424         ar.catalog[filePath].dataStartPos +:= numChars;
  425       end if;
  426     end for;
  427   end func;
  428 
  429 
  430 const proc: setHeaderFileName (inout arArchive: ar, inout arHeader: header) is func
  431   local
  432     var string: filePath8 is "";
  433     var string: longNames is "";
  434     var arHeader: longNamesHeader is arHeader.value;
  435   begin
  436     # writeln("setHeaderFileName: " <& header.filePath);
  437     filePath8 := striToUtf8(header.filePath);
  438     if length(filePath8) >= 16 then
  439       # Although 16 chars would fit a long name is used.
  440       longNames := ar.longNames;
  441       header.longNameStart := addLongName(longNames, filePath8);
  442       if longNames <> ar.longNames then
  443         if ar.longNamesHeaderPos <> 0 then
  444           if length(longNames) > length(ar.longNames) then
  445             longNamesHeader.filePath := "/";
  446             longNamesHeader.fileSize := length(longNames);
  447             seek(ar.arFile, ar.longNamesHeaderPos);
  448             writeHead(ar.arFile, longNamesHeader);
  449             insertArea(ar.arFile, ar.longNamesHeaderPos + AR_HEADER_SIZE,
  450                         length(longNames) - length(ar.longNames));
  451             fixRegisterAndCatalog(ar, ar.longNamesHeaderPos + AR_HEADER_SIZE,
  452                                   length(longNames) - length(ar.longNames));
  453           end if;
  454           # writeln("update existing // header");
  455           seek(ar.arFile, ar.longNamesHeaderPos + AR_HEADER_SIZE);
  456           write(ar.arFile, longNames);
  457         else
  458           ar.longNamesHeaderPos := 1 + length(AR_MAGIC);
  459           insertArea(ar.arFile, ar.longNamesHeaderPos,
  460                       AR_HEADER_SIZE + length(longNames) - length(ar.longNames));
  461           fixRegisterAndCatalog(ar, ar.longNamesHeaderPos,
  462                                 AR_HEADER_SIZE + length(longNames) - length(ar.longNames));
  463           # writeln("create new // header");
  464           longNamesHeader.filePath := "/";
  465           longNamesHeader.fileSize := length(longNames);
  466           seek(ar.arFile, ar.longNamesHeaderPos);
  467           writeHead(ar.arFile, longNamesHeader);
  468           write(ar.arFile, longNames);
  469         end if;
  470         ar.longNames := longNames;
  471       end if;
  472     end if;
  473   end func;
  474 
  475 
  476 (**
  477  *  Determine the file names in a directory inside an AR archive.
  478  *  Note that the function returns only the file names.
  479  *  Additional information must be obtained with other calls.
  480  *  @param ar Open AR archive.
  481  *  @param dirPath path of a directory in the AR archive.
  482  *  @return an array with the file names.
  483  *  @exception RANGE_ERROR ''dirPath'' does not use the standard path
  484  *             representation.
  485  *  @exception FILE_ERROR ''dirPath'' is not present in the AR archive.
  486  *)
  487 const func array string: readDir (inout arArchive: ar, in string: dirPath) is func
  488   result
  489     var array string: fileNames is 0 times "";
  490   local
  491     var string: filePath is "";
  492     var boolean: dirExists is FALSE;
  493     var set of string: fileNameSet is (set of string).value;
  494     var string: fileName is "";
  495     var integer: slashPos is 0;
  496   begin
  497     if dirPath <> "/" and endsWith(dirPath, "/") then
  498       raise RANGE_ERROR;
  499     elsif dirPath = "" or dirPath = "." then
  500       for key fileName range ar.register do
  501         slashPos := pos(fileName, '/');
  502         if slashPos <> 0 then
  503           if slashPos = 1 then
  504             fileName := "/";
  505           else
  506             fileName := fileName[.. pred(slashPos)];
  507           end if;
  508         end if;
  509         if fileName not in fileNameSet then
  510           incl(fileNameSet, fileName);
  511         end if;
  512       end for;
  513     else
  514       for key filePath range ar.register do
  515         if startsWith(filePath, dirPath) then
  516           fileName := filePath[succ(length(dirPath)) ..];
  517           if fileName = "" then
  518             dirExists := TRUE;
  519           elsif startsWith(fileName, "/") then
  520             fileName := fileName[2 ..];
  521           elsif dirPath <> "/" then
  522             fileName := "";  # A file name <> dirPath starts with dirPath.
  523           end if;
  524           slashPos := pos(fileName, '/');
  525           if slashPos <> 0 then
  526             fileName := fileName[.. pred(slashPos)];
  527           end if;
  528           if fileName <> "" and fileName not in fileNameSet then
  529             incl(fileNameSet, fileName);
  530             dirExists := TRUE;
  531           end if;
  532         end if;
  533       end for;
  534       if not dirExists then
  535         raise FILE_ERROR;
  536       end if;
  537     end if;
  538     fileNames := sort(toArray(fileNameSet));
  539   end func;
  540 
  541 
  542 (**
  543  *  Determine the file paths in an AR archive.
  544  *  Note that the function returns only the file paths.
  545  *  Additional information must be obtained with other calls.
  546  *  @param ar Open AR archive.
  547  *  @return an array with the file paths.
  548  *)
  549 const func array string: readDir (inout arArchive: ar, RECURSIVE) is
  550   return sort(keys(ar.register));
  551 
  552 
  553 (**
  554  *  Determine the type of a file in an AR archive.
  555  *  The function does follow symbolic links. If the chain of
  556  *  symbolic links is too long the function returns ''FILE_SYMLINK''.
  557  *  If a symbolic link refers to a place where the permission
  558  *  is denied the function returns ''FILE_SYMLINK''.
  559  *  A return value of ''FILE_ABSENT'' does not imply that a file
  560  *  with this name can be created, since missing directories and
  561  *  illegal file names cause also ''FILE_ABSENT''.
  562  *  @return the type of the file.
  563  *  @exception RANGE_ERROR ''filePath'' does not use the standard path
  564  *             representation.
  565  *)
  566 const func fileType: fileType (inout arArchive: ar, in var string: filePath) is func
  567   result
  568     var fileType: aFileType is FILE_UNKNOWN;
  569   local
  570     var arHeader: header is arHeader.value;
  571     var integer: symlinkCount is 5;
  572   begin
  573     # writeln("fileType: " <& filePath);
  574     if filePath <> "/" and endsWith(filePath, "/") then
  575       raise RANGE_ERROR;
  576     elsif filePath = "" then
  577       aFileType := FILE_DIR;
  578     else
  579       repeat
  580         if filePath in ar.catalog then
  581           header := ar.catalog[filePath];
  582         elsif filePath in ar.register then
  583           header := addToCatalog(ar, filePath);
  584         elsif implicitDir(ar, filePath) then
  585           header := addImplicitDir(ar, filePath);
  586         else
  587           aFileType := FILE_ABSENT;
  588         end if;
  589         if aFileType = FILE_UNKNOWN then
  590           case bin32(header.mode) & MODE_FILE_TYPE_MASK of
  591             when {MODE_FILE_REGULAR}: aFileType := FILE_REGULAR;
  592             when {MODE_FILE_DIR}:     aFileType := FILE_DIR;
  593             when {MODE_FILE_CHAR}:    aFileType := FILE_CHAR;
  594             when {MODE_FILE_BLOCK}:   aFileType := FILE_BLOCK;
  595             when {MODE_FILE_FIFO}:    aFileType := FILE_FIFO;
  596             when {MODE_FILE_SOCKET}:  aFileType := FILE_SOCKET;
  597             when {MODE_FILE_SYMLINK}:
  598               seek(ar.arFile, header.dataStartPos);
  599               filePath := gets(ar.arFile, header.fileSize);
  600             otherwise:
  601               raise RANGE_ERROR;
  602           end case;
  603         end if;
  604         decr(symlinkCount);
  605       until aFileType <> FILE_UNKNOWN or symlinkCount = 0;
  606     end if;
  607   end func;
  608 
  609 
  610 (**
  611  *  Determine the type of a file in an AR archive.
  612  *  The function does not follow symbolic links. Therefore it may
  613  *  return ''FILE_SYMLINK''. A return value of ''FILE_ABSENT'' does
  614  *  not imply that a file with this name can be created, since missing
  615  *  directories and illegal file names cause also ''FILE_ABSENT''.
  616  *  @return the type of the file.
  617  *  @exception RANGE_ERROR ''filePath'' does not use the standard path
  618  *             representation.
  619  *)
  620 const func fileType: fileTypeSL (inout arArchive: ar, in string: filePath) is func
  621   result
  622     var fileType: aFileType is FILE_UNKNOWN;
  623   local
  624     var integer: modeValue is 0;
  625   begin
  626     # writeln("fileTypeSL: " <& filePath);
  627     if filePath <> "/" and endsWith(filePath, "/") then
  628       raise RANGE_ERROR;
  629     elsif filePath = "" then
  630       aFileType := FILE_DIR;
  631     else
  632       if filePath in ar.catalog then
  633         modeValue := ar.catalog[filePath].mode;
  634       elsif filePath in ar.register then
  635         modeValue := addToCatalog(ar, filePath).mode;
  636       elsif implicitDir(ar, filePath) then
  637         modeValue := addImplicitDir(ar, filePath).mode;
  638       else
  639         aFileType := FILE_ABSENT;
  640       end if;
  641       if aFileType = FILE_UNKNOWN then
  642         # writeln("modeValue: " <& modeValue radix 8);
  643         case bin32(modeValue) & MODE_FILE_TYPE_MASK of
  644           when {MODE_FILE_REGULAR}: aFileType := FILE_REGULAR;
  645           when {MODE_FILE_DIR}:     aFileType := FILE_DIR;
  646           when {MODE_FILE_CHAR}:    aFileType := FILE_CHAR;
  647           when {MODE_FILE_BLOCK}:   aFileType := FILE_BLOCK;
  648           when {MODE_FILE_FIFO}:    aFileType := FILE_FIFO;
  649           when {MODE_FILE_SOCKET}:  aFileType := FILE_SOCKET;
  650           when {MODE_FILE_SYMLINK}: aFileType := FILE_SYMLINK;
  651           otherwise:
  652             raise RANGE_ERROR;
  653         end case;
  654       end if;
  655     end if;
  656   end func;
  657 
  658 
  659 (**
  660  *  Determine the file mode (permissions) of a file in an AR archive.
  661  *  @return the file mode.
  662  *  @exception RANGE_ERROR ''filePath'' does not use the standard path
  663  *             representation.
  664  *  @exception FILE_ERROR ''filePath'' is not present in the AR archive.
  665  *)
  666 const func fileMode: fileMode (inout arArchive: ar, in string: filePath) is func
  667   result
  668     var fileMode: mode is fileMode.value;
  669   local
  670     var integer: modeValue is 0;
  671   begin
  672     if filePath <> "/" and endsWith(filePath, "/") then
  673       raise RANGE_ERROR;
  674     elsif filePath in ar.catalog then
  675       modeValue := ar.catalog[filePath].mode;
  676     elsif filePath in ar.register then
  677       modeValue := addToCatalog(ar, filePath).mode;
  678     elsif implicitDir(ar, filePath) then
  679       modeValue := addImplicitDir(ar, filePath).mode;
  680     else
  681       raise FILE_ERROR;
  682     end if;
  683     # writeln(filePath <& " mode: " <& modeValue radix 8);
  684     mode := fileMode conv modeValue;
  685   end func;
  686 
  687 
  688 (**
  689  *  Change the file mode (permissions) of a file in an AR archive.
  690  *  @exception RANGE_ERROR ''filePath'' does not use the standard path
  691  *             representation.
  692  *  @exception FILE_ERROR ''filePath'' is not present in the AR archive.
  693  *)
  694 const proc: setFileMode (inout arArchive: ar, in string: filePath,
  695     in fileMode: mode) is func
  696   local
  697     var arHeader: header is arHeader.value;
  698   begin
  699     if filePath <> "/" and endsWith(filePath, "/") then
  700       raise RANGE_ERROR;
  701     elsif filePath in ar.catalog then
  702       ar.catalog[filePath].mode := (ar.catalog[filePath].mode >> 9 << 9) +
  703           integer(mode);
  704     elsif filePath in ar.register then
  705       header := addToCatalog(ar, filePath);
  706       header.mode := (header.mode >> 9 << 9) + integer(mode);
  707       ar.catalog @:= [filePath] header;
  708     else
  709       raise FILE_ERROR;
  710     end if;
  711     seek(ar.arFile, ar.register[filePath]);
  712     writeHead(ar.arFile, ar.catalog[filePath]);
  713   end func;
  714 
  715 
  716 (**
  717  *  Determine the size of a file in an AR archive.
  718  *  The file size is measured in bytes.
  719  *  For directories a size of 0 is returned.
  720  *  @return the size of the file.
  721  *  @exception RANGE_ERROR ''filePath'' does not use the standard path
  722  *             representation.
  723  *  @exception FILE_ERROR ''filePath'' is not present in the AR archive.
  724  *)
  725 const func integer: fileSize (inout arArchive: ar, in string: filePath) is func
  726   result
  727     var integer: size is 0;
  728   local
  729     var arHeader: header is arHeader.value;
  730   begin
  731     if filePath <> "/" and endsWith(filePath, "/") then
  732       raise RANGE_ERROR;
  733     elsif filePath in ar.catalog then
  734       size := ar.catalog[filePath].fileSize;
  735     elsif filePath in ar.register then
  736       size := addToCatalog(ar, filePath).fileSize;
  737     elsif implicitDir(ar, filePath) then
  738       size := addImplicitDir(ar, filePath).fileSize;
  739     else
  740       raise FILE_ERROR;
  741     end if;
  742   end func;
  743 
  744 
  745 (**
  746  *  Determine the modification time of a file in an AR archive.
  747  *  @return the modification time of the file.
  748  *  @exception RANGE_ERROR ''filePath'' does not use the standard path
  749  *             representation.
  750  *  @exception FILE_ERROR ''filePath'' is not present in the AR archive.
  751  *)
  752 const func time: getMTime (inout arArchive: ar, in string: filePath) is func
  753   result
  754     var time: modificationTime is time.value;
  755   local
  756     var arHeader: header is arHeader.value;
  757     var integer: mtime is 0;
  758   begin
  759     if filePath <> "/" and endsWith(filePath, "/") then
  760       raise RANGE_ERROR;
  761     elsif filePath in ar.catalog then
  762       mtime := ar.catalog[filePath].mtime;
  763     elsif filePath in ar.register then
  764       mtime := addToCatalog(ar, filePath).mtime;
  765     elsif implicitDir(ar, filePath) then
  766       mtime := addImplicitDir(ar, filePath).mtime;
  767     else
  768       raise FILE_ERROR;
  769     end if;
  770     modificationTime := timestamp1970ToTime(mtime);
  771   end func;
  772 
  773 
  774 (**
  775  *  Set the modification time of a file in an AR archive.
  776  *  @exception RANGE_ERROR ''filePath'' does not use the standard path
  777  *             representation.
  778  *  @exception RANGE_ERROR ''aTime'' is invalid or cannot be
  779  *             converted to the system file time.
  780  *  @exception FILE_ERROR ''filePath'' is not present in the AR archive.
  781  *)
  782 const proc: setMTime (inout arArchive: ar, in string: filePath,
  783     in time: modificationTime) is func
  784   local
  785     var integer: mtime is 0;
  786     var arHeader: header is arHeader.value;
  787   begin
  788     mtime := timestamp1970(modificationTime);
  789     if mtime < 0 or mtime >= 2 ** 31 or
  790         (filePath <> "/" and endsWith(filePath, "/")) then
  791       raise RANGE_ERROR;
  792     elsif filePath in ar.catalog then
  793       ar.catalog[filePath].mtime := mtime;
  794     elsif filePath in ar.register then
  795       header := addToCatalog(ar, filePath);
  796       header.mtime := mtime;
  797       ar.catalog @:= [filePath] header;
  798     else
  799       raise FILE_ERROR;
  800     end if;
  801     seek(ar.arFile, ar.register[filePath]);
  802     writeHead(ar.arFile, ar.catalog[filePath]);
  803   end func;
  804 
  805 
  806 (**
  807  *  Determine the name of the owner (UID) of a file in a AR archive.
  808  *  @return the name of the file owner.
  809  *  @exception RANGE_ERROR ''filePath'' does not use the standard path
  810  *             representation.
  811  *  @exception FILE_ERROR ''filePath'' is not present in the AR archive, or
  812  *             the chain of symbolic links is too long.
  813  *)
  814 const func string: getOwner (inout arArchive: ar, in string: filePath) is func
  815   result
  816     var string: owner is "";
  817   local
  818     var integer: uid is 0;
  819   begin
  820     if filePath <> "/" and endsWith(filePath, "/") then
  821       raise RANGE_ERROR;
  822     elsif filePath in ar.catalog then
  823       uid := ar.catalog[filePath].ownerId;
  824     elsif filePath in ar.register then
  825       uid := addToCatalog(ar, filePath).ownerId;
  826     elsif implicitDir(ar, filePath) then
  827       uid := addImplicitDir(ar, filePath).ownerId;
  828     else
  829       raise FILE_ERROR;
  830     end if;
  831     # writeln(filePath <& " uid: " <& uid);
  832     owner := str(uid);
  833   end func;
  834 
  835 
  836 (**
  837  *  Determine the name of the group (GID) of a file in a AR archive.
  838  *  @return the name of the file group.
  839  *  @exception RANGE_ERROR ''filePath'' does not use the standard path
  840  *             representation.
  841  *  @exception FILE_ERROR ''filePath'' is not present in the AR archive, or
  842  *             the chain of symbolic links is too long.
  843  *)
  844 const func string: getGroup (inout arArchive: ar, in string: filePath) is func
  845   result
  846     var string: group is "";
  847   local
  848     var integer: gid is 0;
  849   begin
  850     if filePath <> "/" and endsWith(filePath, "/") then
  851       raise RANGE_ERROR;
  852     elsif filePath in ar.catalog then
  853       gid := ar.catalog[filePath].groupId;
  854     elsif filePath in ar.register then
  855       gid := addToCatalog(ar, filePath).groupId;
  856     elsif implicitDir(ar, filePath) then
  857       gid := addImplicitDir(ar, filePath).groupId;
  858     else
  859       raise FILE_ERROR;
  860     end if;
  861     # writeln(filePath <& " gid: " <& gid);
  862     group := str(gid);
  863   end func;
  864 
  865 
  866 (**
  867  *  Get the contents of a file in an AR archive.
  868  *  @return the specified file as string.
  869  *  @exception RANGE_ERROR ''filePath'' does not use the standard path
  870  *             representation.
  871  *  @exception FILE_ERROR ''filePath'' is not present in the AR archive,
  872  *             or is not a regular file.
  873  *)
  874 const func string: getFile (inout arArchive: ar, in string: filePath) is func
  875   result
  876     var string: content is "";
  877   local
  878     var arHeader: header is arHeader.value;
  879   begin
  880     if filePath <> "/" and endsWith(filePath, "/") then
  881       raise RANGE_ERROR;
  882     elsif filePath in ar.catalog then
  883       header := ar.catalog[filePath];
  884       if bin32(header.mode) & MODE_FILE_TYPE_MASK = MODE_FILE_REGULAR then
  885         seek(ar.arFile, header.dataStartPos);
  886       end if;
  887     elsif filePath in ar.register then
  888       header := addToCatalog(ar, filePath);
  889     else
  890       raise FILE_ERROR;
  891     end if;
  892     if bin32(header.mode) & MODE_FILE_TYPE_MASK = MODE_FILE_REGULAR then
  893       content := gets(ar.arFile, header.fileSize);
  894     else
  895       raise FILE_ERROR;
  896     end if;
  897   end func;
  898 
  899 
  900 (**
  901  *  Write ''data'' to an AR archive with the given ''filePath''.
  902  *  If the file exists already, it is overwritten.
  903  *  @exception RANGE_ERROR ''filePath'' does not use the standard path
  904  *             representation.
  905  *)
  906 const proc: putFile (inout arArchive: ar, in string: filePath,
  907     in string: data) is func
  908   local
  909     var arHeader: header is arHeader.value;
  910     var boolean: fileExists is TRUE;
  911     var integer: oldPaddedSize is 0;
  912     var integer: newPaddedSize is 0;
  913     var integer: length is 0;
  914   begin
  915     # writeln("putFile(" <& literal(filePath) <& ")");
  916     if filePath = "" or filePath <> "/" and endsWith(filePath, "/") then
  917       raise RANGE_ERROR;
  918     elsif filePath in ar.catalog then
  919       header := ar.catalog[filePath];
  920     elsif filePath in ar.register then
  921       header := addToCatalog(ar, filePath);
  922     elsif implicitDir(ar, filePath) then
  923       raise FILE_ERROR;
  924     else
  925       fileExists := FALSE;
  926     end if;
  927     if fileExists then
  928       if bin32(header.mode) & MODE_FILE_TYPE_MASK <> MODE_FILE_REGULAR then
  929         raise FILE_ERROR;
  930       else
  931         oldPaddedSize := succ(pred(header.fileSize) mdiv AR_PADDING) * AR_PADDING;
  932         newPaddedSize := succ(pred(length(data)) mdiv AR_PADDING) * AR_PADDING;
  933         # writeln("oldPaddedSize: " <& oldPaddedSize);
  934         # writeln("newPaddedSize: " <& newPaddedSize);
  935         if newPaddedSize > oldPaddedSize then
  936           insertArea(ar.arFile, header.dataStartPos, newPaddedSize - oldPaddedSize);
  937           fixRegisterAndCatalog(ar, header.dataStartPos, newPaddedSize - oldPaddedSize);
  938         elsif newPaddedSize < oldPaddedSize then
  939           deleteArea(ar.arFile, header.dataStartPos, oldPaddedSize - newPaddedSize);
  940           fixRegisterAndCatalog(ar, header.dataStartPos + (oldPaddedSize - newPaddedSize),
  941                                 newPaddedSize - oldPaddedSize);
  942         end if;
  943         # The file data is rewritten in place.
  944         header.fileSize := length(data);
  945         ar.catalog @:= [filePath] header;
  946         seek(ar.arFile, ar.register[filePath]);
  947         writeHead(ar.arFile, header);
  948         write(ar.arFile, data);
  949         write(ar.arFile, "\0;" mult pred(AR_PADDING) -
  950               pred(header.fileSize) mod AR_PADDING);
  951         flush(ar.arFile);
  952       end if;
  953     else
  954       length := length(ar.arFile);
  955       if length = 0 then
  956         write(ar.arFile, AR_MAGIC);
  957       end if;
  958       if not fileExists then
  959         header.filePath   := filePath;
  960         header.mtime      := timestamp1970(time(NOW));
  961         header.ownerId    := 100;
  962         header.groupId    := 100;
  963         header.mode       := ord(MODE_FILE_REGULAR) + 8#664;
  964       end if;
  965       header.fileSize := length(data);
  966       setHeaderFileName(ar, header);
  967       length := length(ar.arFile);
  968       ar.register @:= [filePath] succ(length);
  969       # writeln("ar.register[" <& literal(filePath) <& "]: " <& ar.register[filePath]);
  970       seek(ar.arFile, succ(length));
  971       writeHead(ar.arFile, header);
  972       header.dataStartPos := tell(ar.arFile);
  973       ar.catalog @:= [filePath] header;
  974       write(ar.arFile, data);
  975       write(ar.arFile, "\0;" mult pred(AR_PADDING) -
  976             pred(header.fileSize) mod AR_PADDING);
  977       flush(ar.arFile);
  978     end if;
  979   end func;
  980 
  981 
  982 (**
  983  *  Remove a file (if it is not a directory), from an AR archive.
  984  *  @exception RANGE_ERROR ''filePath'' does not use the standard path
  985  *             representation.
  986  *  @exception FILE_ERROR The file does not exist or it is a directory.
  987  *)
  988 const proc: removeFile (inout arArchive: ar, in string: filePath) is func
  989   local
  990     var arHeader: header is arHeader.value;
  991     var boolean: fileExists is TRUE;
  992     var integer: numCharsToBeRemoved is 0;
  993     var integer: posOfHeaderToBeRemoved is 0;
  994   begin
  995     # writeln("removeFile(" <& literal(filePath) <& ")");
  996     if filePath <> "/" and endsWith(filePath, "/") then
  997       raise RANGE_ERROR;
  998     elsif filePath in ar.catalog then
  999       header := ar.catalog[filePath];
 1000     elsif filePath in ar.register then
 1001       header := addToCatalog(ar, filePath);
 1002     elsif implicitDir(ar, filePath) then
 1003       header := addImplicitDir(ar, filePath);
 1004     else
 1005       fileExists := FALSE;
 1006     end if;
 1007     if fileExists then
 1008       if bin32(header.mode) & MODE_FILE_TYPE_MASK <> MODE_FILE_REGULAR then
 1009         raise FILE_ERROR;
 1010       else
 1011         numCharsToBeRemoved := AR_HEADER_SIZE + succ(pred(header.fileSize) mdiv AR_PADDING) * AR_PADDING;
 1012         # writeln("numCharsToBeRemoved: " <& numCharsToBeRemoved);
 1013         posOfHeaderToBeRemoved := ar.register[filePath];
 1014         deleteArea(ar.arFile, posOfHeaderToBeRemoved, numCharsToBeRemoved);
 1015         excl(ar.register, filePath);
 1016         excl(ar.catalog, filePath);
 1017         fixRegisterAndCatalog(ar, posOfHeaderToBeRemoved + numCharsToBeRemoved,
 1018                               -numCharsToBeRemoved);
 1019         flush(ar.arFile);
 1020       end if;
 1021     else
 1022       raise FILE_ERROR;
 1023     end if;
 1024   end func;
 1025 
 1026 
 1027 (**
 1028  *  For-loop which loops recursively over the paths in an AR archive.
 1029  *)
 1030 const proc: for (inout string: filePath) range (inout arArchive: ar) do
 1031               (in proc: statements)
 1032             end for is func
 1033   begin
 1034     for key filePath range ar.register do
 1035       statements;
 1036     end for;
 1037   end func;
 1038 
 1039 
 1040 const func file: openFileInAr (inout arArchive: ar, in string: filePath,
 1041     in string: mode) is func
 1042   result
 1043     var file: newFile is STD_NULL;
 1044   local
 1045     var arHeader: header is arHeader.value;
 1046     var boolean: okay is TRUE;
 1047   begin
 1048     if mode = "r" then
 1049       if filePath <> "/" and endsWith(filePath, "/") then
 1050         raise RANGE_ERROR;
 1051       elsif filePath in ar.catalog then
 1052         header := ar.catalog[filePath];
 1053       elsif filePath in ar.register then
 1054         header := addToCatalog(ar, filePath);
 1055       elsif implicitDir(ar, filePath) then
 1056         header := addImplicitDir(ar, filePath);
 1057       else
 1058         okay := FALSE;
 1059       end if;
 1060       if okay and
 1061           bin32(header.mode) & MODE_FILE_TYPE_MASK = MODE_FILE_REGULAR then
 1062         newFile := openSubFile(ar.arFile, header.dataStartPos, header.fileSize);
 1063       end if;
 1064     end if;
 1065   end func;
 1066 
 1067 
 1068 (**
 1069  *  Open a file with ''filePath'' and ''mode'' in in an AR archive.
 1070  *)
 1071 const func file: open (inout arArchive: ar, in string: filePath,
 1072     in string: mode) is
 1073   return openBufferFile(openFileInAr(ar, filePath, mode));