Difference between revisions of "AmigaDos.SystemTagList()"

From Freepascal Amiga wiki
Jump to navigation Jump to search
m (→‎Executing Asynchrone and catching Output.: Removed redundant indent from source)
 
(2 intermediate revisions by the same user not shown)
Line 79: Line 79:
 
pipe-handle unusable as the last read-command done on the pipe-handle would let that read-command wait forever until no-one (in this case the receiving-end itself) has the handle open for writing. The only way that somewhat solves this, is using the NP_ExitCode tag and in that called code, close the pipe-handle of the receiving end (in order to let the receiver's last read command 'unlock' so it can continue. But by doing so, it would also make the receiver's routine useless as it has no acces to the pipe-handler anymore. Besides that, the last read done by the recieving-end with the last read on the handle would also contain garbled values towards the end of what the last read tells that was possible to read (as some functions return how many bytes/characters were read).
 
pipe-handle unusable as the last read-command done on the pipe-handle would let that read-command wait forever until no-one (in this case the receiving-end itself) has the handle open for writing. The only way that somewhat solves this, is using the NP_ExitCode tag and in that called code, close the pipe-handle of the receiving end (in order to let the receiver's last read command 'unlock' so it can continue. But by doing so, it would also make the receiver's routine useless as it has no acces to the pipe-handler anymore. Besides that, the last read done by the recieving-end with the last read on the handle would also contain garbled values towards the end of what the last read tells that was possible to read (as some functions return how many bytes/characters were read).
  
 +
'''NOTE:'''
 +
As of abi-v0-on-trunk becoming mainstream abi-v0 (sep 2014), the above information isn't correct anymore. Use PIPE: device to handle your piped buffers. As a result, things behave more (if not completely) consistent with amigaOS 3.x pipe: device and handler.
  
 
== How to use SystemTagList() in practise ==
 
== How to use SystemTagList() in practise ==
Line 317: Line 319:
 
<source lang="pascal">
 
<source lang="pascal">
 
program RunCMDoe;
 
program RunCMDoe;
 
+
 
{
 
{
   Name  : RunCMDoe V0.1
+
   Name  : RunCMDoe V0.6
 
   Target : AROS ABIv0/i386
 
   Target : AROS ABIv0/i386
   Author : n/a
+
   Author : Molly
   Date  : 2013-09-19
+
   Date  : 2014-12-20
 
   Goal  : Run a command using SystemTagList() and catch its output and error
 
   Goal  : Run a command using SystemTagList() and catch its output and error
   usage  : RunCMDio Command [parameter1 parameter2 parameterN]
+
   usage  : RunCMDoe Command [parameter1 parameter2 parameterN]
 
   Note  : Code only tested on 'simple' commands. Not tested against
 
   Note  : Code only tested on 'simple' commands. Not tested against
 
           commands that produces multiple consecutive output and error
 
           commands that produces multiple consecutive output and error
 
           messages.
 
           messages.
 +
 +
  Important Information:
 +
  abi_v0_on_trunk brings improvements:
 +
  PipeFS: seems gone, use Pipe: instead also "*" works now.
 +
  The Pipe: device seems to work identical as on classic.
 
}
 
}
  
 
+
 
{$MODE OBJFPC}{$H+}
 
{$MODE OBJFPC}{$H+}
 +
 +
 +
uses
 +
  classes, exec, amigados, utility, tagsarray;
  
 
uses
 
  exec, amigados, utility, tagsarray;
 
  
  
Line 346: Line 354:
 
   );
 
   );
  
 +
 +
  TPipeSettings    = record   
 +
    PipeName        : String;
 +
    ReadHandle      : BPTR;
 +
    WriteHandle    : BPTR;
 +
    EOFReached      : boolean;
 +
  end;
 +
 +
 
var
 
var
 
   CommandHasEnded  : boolean = false;
 
   CommandHasEnded  : boolean = false;
 
   CommandExitCode  : longint = 0;
 
   CommandExitCode  : longint = 0;
 
   CommandSegList    : BPTR    = nil;
 
   CommandSegList    : BPTR    = nil;
 +
 +
  StringCollector  : TMemoryStream;
 +
  
Var
 
  OutPipeRead      : BPTR;
 
  OutPipeWrite      : BPTR;
 
  ErrorPipeRead    : BPTR;
 
  ErrorPipeWrite    : BPTR;
 
 
Const
 
  OutPipeName      = 'PIPEFS:CmdOut';
 
  ErrorPipeName    = 'PIPEFS:CmdErr';
 
  
 +
// ==========================================================================
 +
// routine to add a String to a memorystream
 +
// ==========================================================================
 +
Procedure AddString(M: TMemoryStream; S: String);
 +
var i: integer;
 +
begin
 +
  For i := 1 to length(S) do M.WriteByte(Byte(S[i]));
 +
end;
  
  
 +
 +
// ==========================================================================
 +
// return function provided to SystemTagsList
 +
// ==========================================================================
 
Procedure CMDExitCode(retcode: LongInt; SegList: BPTR); cdecl;
 
Procedure CMDExitCode(retcode: LongInt; SegList: BPTR); cdecl;
 +
var
 +
  ops : Text;
 
begin
 
begin
   Writeln('Enter - CMDExitCode()');
+
  CommandHasEnded := true;
 +
 
 +
  ops := System.Output;
 +
   Writeln(ops, 'Enter - CMDExitCode()');
  
  CommandHasEnded := true;
 
 
   CommandExitCode := retcode;
 
   CommandExitCode := retcode;
 
   CommandSegList  := SegList;
 
   CommandSegList  := SegList;
 
+
   Writeln('CMDExitCode(): exitcode =', CommandExitCode);
+
   Writeln(ops, 'CMDExitCode(): exitcode =', CommandExitCode);
   Writeln('CMDExitCode(): seglist  =', LongWord(CommandSegList));
+
   Writeln(ops, 'CMDExitCode(): seglist  =', LongWord(CommandSegList));
 
+
   Writeln('Leave - CMDExitCode()');
+
   Writeln(ops, 'Leave - CMDExitCode()');
 
end;
 
end;
 +
  
  
 
// ==========================================================================
 
// read the errorpipe
 
// ==========================================================================
 
// IMPORTANT: THIS IS A SEPERATE THREAD/PROCESS/TASK, DO NOT USE FUNCTIONS
 
// UNLESS LIBRARIES ARE VALID FOR THIS TASK.
 
 
//
 
//
// The code used in this routine is doing things non-threadsafe, be warned
+
// Creates an actual pipe-buffer from supplied PipeConfig, and returns
// ==========================================================================
+
// true when succeeded
Procedure ReadPipeErrorThread; cdecl;
+
//
var
+
Function CreatePipeLink(var APipe: TPipeSettings): boolean;
  nread : LongInt;
+
Var
   ErrorPipeBuffer: packed array[0..255] of char;
+
   NameBuf        : Packed array[0.. 63] of Char;
  ops : Text;
 
 
begin
 
begin
   ops := System.Output; // <- naughty, getting output from main task.
+
   Result := false;
 +
 
 +
  APipe.ReadHandle  := nil;
 +
  APipe.WriteHandle := nil;
 +
 
 +
  APipe.WriteHandle := DosOpen( PChar(APipe.PipeName), MODE_NEWFILE);
 +
  If (APipe.WriteHandle = nil) then exit;
  
   writeln(ops,'ReadPipeErrorThread - started');
+
   if Not (NameFromFH (APipe.WriteHandle, NameBuf, Sizeof(NameBuf))) then exit;
  while not CommandHasEnded do
+
  APipe.PipeName    := NameBuf; // copy real name
  begin
+
 
    while true do
+
  APipe.ReadHandle  := DosOpen(NameBuf, MODE_OLDFILE);
    begin
+
  If (APipe.ReadHandle = nil) then exit;
      writeln(ops, 'ReadPipeErrorThread(): start a buffer read from ErrorPipe');
+
 
      nread := DosRead(ErrorPipeRead, @ErrorPipeBuffer[0], 255);
+
  result := true;
      // -1 = error, 0 = EOF and >0 = number of bytes actually read.
 
      if (nread <> -1) then
 
      begin
 
        writeln(ops, 'ReadPipeErrorThread(): buffer read from OutPipe was succesfull');
 
        ErrorPipeBuffer[nread] := #0;
 
        writeln(ops, pchar(ErrorPipeBuffer));
 
        if (nread < 255) then break; // be bold and assume <255 means we are done
 
      end
 
      else
 
      begin
 
        writeln(ops, 'ReadPipeErrorThread(): ERROR - buffer read failed, IoErr() = ', IoErr);
 
        break;
 
      end;
 
    end;
 
  end; // while not CommandHasEnded
 
  writeln(ops,'ReadPipeErrorThread - ended');
 
  //flush(ops);
 
 
end;
 
end;
// ==========================================================================
 
  
  
  
// ==========================================================================
 
// read the outputpipe
 
// ==========================================================================
 
// IMPORTANT: THIS IS A SEPERATE THREAD/PROCESS/TASK, DO NOT USE FUNCTIONS
 
// UNLESS LIBRARIES ARE VALID FOR THIS TASK.
 
 
//
 
//
// The code used in this routine is doing things non-threadsafe, be warned
+
// read data from given APipe and return a value indicating state of read
// ==========================================================================
+
// return value:
Procedure ReadPipeOutputThread; cdecl;
+
// = EOF
 +
// < 0 = error
 +
// > 0 = nt of characters returned in RetBug
 +
//
 +
function ReadFromPipe(var APipe: TPipeSettings; Var RetBuf: String): LongInt;
 
var
 
var
   nread : LongInt;
+
   RDBuffer  : packed array[0..63] of char;
  OutPipeBuffer: packed array[0..255] of char;
+
   PRDBuffer : Pchar;
   ops: Text;
+
  ThisErr  : LongInt;
 +
  fib      : TFileInfoBlock;
 
begin
 
begin
   ops := System.Output;  // <- naughty, getting output from main task.
+
   // some small debug info
   writeln(ops,'ReadPipeOutputThread - started'); // naughty, using main task libraries/memory ?
+
  If ExamineFH(APipe.Readhandle, @fib)
   while not CommandHasEnded do  // naughty, reading global variable non-threadsafe
+
   then writeln('bytes in buffer = ', fib.fib_size);
 +
 
 +
  PRDBuffer := @RDBuffer[0];
 +
  RetBuf    := '';
 +
 
 +
  // According to RKRM:
 +
  // If FGets()'s returned buffer nil, either error or EOF occured.
 +
  // If ioErr() = 0 then EOF else error-code.
 +
   // error-codes are not handled appropriately in this code
 +
 
 +
  if FgetS(APipe.ReadHandle, PRDBuffer, Sizeof(RDBuffer)) <> nil then
 +
  begin
 +
    RetBuf := StrPas(PRDBuffer);
 +
    Result := Length(RetBuf);
 +
  end
 +
  else
 
   begin
 
   begin
     while true do
+
     ThisErr := amigados.IoErr;
 +
             
 +
    If ( ThisErr = 0 ) then
 
     begin
 
     begin
       writeln(ops, 'ReadPipeOutputThread(): start a buffer read from OutPipe'); // another naughty writeln
+
       RetBuf := '';
       nread := DosRead(OutPipeRead, @OutPipeBuffer[0], 255); // <- naughty, using doslib without opening own.
+
       APipe.EOFReached := True;
      // -1 = error, 0 = EOF and >0 = number of bytes actually read.
+
       Result := 0;
       if (nread <> -1) then
+
    end
      begin
+
    else
        writeln(ops, 'ReadPipeOutputThread(): buffer read from OutPipe was succesfull'); // another naughty writeln
+
    begin
        OutPipeBuffer[nread] := #0;
+
      WriteStr(RetBuf, 'DOS ERROR = ', ThisErr);
        writeln(ops, pchar(OutPipeBuffer)); // another naughty writeln
+
       Result := -1;
        if (nread < 255) then break;  // be bold and assume <255 means we are done
 
      end
 
      else
 
      begin
 
        writeln(ops, 'ReadPipeOutputThread(): ERROR - buffer read failed, IoErr() = ', IoErr); // Another naughty doslib call
 
        break;
 
       end;
 
 
     end;
 
     end;
   end; // while not CommandHasEnded
+
   
  writeln(ops,'ReadPipeOutputThread - ended'); // another naughty writeln
+
   end;
 
end;
 
end;
// ==========================================================================
 
  
  
  
procedure RunCMDBoth(CommandToRun: String);
+
procedure RunCMDBoth(CommandToRun: String; var OutPipe: TPipeSettings; var ErrorPipe: TPipeSettings);
Const
 
  MaxLimitCount  = 1000;
 
  LimitCount    : integer = MaxLimitCount;
 
 
var
 
var
   TagsList       : TTagsList = nil;
+
   TagsList     : TTagsList = nil;
   Tags           : pTagItem;
+
   Tags         : pTagItem;
   res           : LongInt;
+
   res           : LongInt;
 
+
   S            : String = '';
   OutPipeDone    : boolean;
 
  ErrorPipeDone  : boolean;
 
 
 
  ErrorPipeReadThread  : pProcess;
 
  OutputPipeReadThread : pProcess;
 
 
 
 
 
 
begin
 
begin
   OutPipeDone    := false;
+
   If CreatePipeLink(OutPipe) and CreatePipeLink(ErrorPipe) then
  ErrorPipeDone  := false;
 
 
 
  OutPipeWrite  := DosOpen(  OutPipeName , MODE_READWRITE);  // OutPipeWrite  := DosOpen( OutPipeName , MODE_NEWFILE);
 
  ErrorPipeWrite := DosOpen( ErrorPipeName , MODE_READWRITE);
 
 
 
  if (OutPipeWrite <> nil) then If (ErrorPipeWrite <> nil) then
 
 
   begin
 
   begin
 +
    writeln('RUNCMD(): OK - opened pipe(s) for read/write acces'); 
 
     addtags(TagsList,
 
     addtags(TagsList,
 
     [
 
     [
       LONG(SYS_Input)      , 0,
+
       LONG(SYS_Input)      , nil,
 
+
       LONG(SYS_Output)      , OutPipeWrite,
+
       LONG(SYS_Output)      , OutPipe.WriteHandle,
 
       LONG(NP_CloseOutput)  , 1,
 
       LONG(NP_CloseOutput)  , 1,
 
+
       LONG(SYS_Error)      , ErrorPipeWrite,
+
       LONG(SYS_Error)      , ErrorPipe.WriteHandle,
 
       LONG(NP_CloseError)  , 1,
 
       LONG(NP_CloseError)  , 1,
 
+
 
       LONG(SYS_Asynch)      , 1,
 
       LONG(SYS_Asynch)      , 1,
 
       LONG(SYS_BackGround)  , 1,
 
       LONG(SYS_BackGround)  , 1,
Line 508: Line 511:
 
     ]);
 
     ]);
 
     Tags := GetTagPtr(TagsList);
 
     Tags := GetTagPtr(TagsList);
 
+
 
     writeln('RUNCMD(): Executing SystemTagList()');
 
     writeln('RUNCMD(): Executing SystemTagList()');
 
     res := SystemTagList(pchar(CommandToRun), Tags);
 
     res := SystemTagList(pchar(CommandToRun), Tags);
 +
 
 
     If (res <> -1) then
 
     If (res <> -1) then
 
     begin
 
     begin
 
       writeln('RUNCMD(): SystemTagList() returned value ', res);
 
       writeln('RUNCMD(): SystemTagList() returned value ', res);
      writeln('RUNCMD(): opening OutPipe fpr reading');
 
      OutPipeRead  := DosOpen( OutPipeName  , MODE_OLDFILE);
 
      ErrorPipeRead := DosOpen( ErrorPipeName , MODE_OLDFILE);
 
  
      if (OutPipeRead <> nil) and (ErrorPipeRead <> nil) then  // needs better solution
 
 
       begin
 
       begin
         writeln('RUNCMD(): Entering main loop for creating both pipes');
+
         Writeln('RUNCMD(): Entering main loop, waiting for Output and Error thread to exit');
 +
       
 +
        //
 +
        //  Main Loop for reading pipe-buffers
 +
        //
 +
        while not CommandHasEnded do
 +
        begin
  
        // because aros and/or pipe refuses to give us one single bit
+
          //
        // and/or function to be able to check if a pipe-handle can
+
          // Handle OutPipe
        // be safely read, we punish it by using a total of 4 (!) tasks
+
          //
        // instead of just 2 (that easily could have managed the job).
+
          If not OutPipe.EOFReached then //if not OutPipeDone then
        // These are the two other threads.
+
          begin
        OutputPipeReadThread := CreateNewProcTags
+
            Res := ReadFromPipe(OutPipe, S);
        ([
 
          LONG(NP_ENTRY)    , @ReadPipeOutputThread,
 
          LONG(NP_Priority)  , 1,
 
          LONG(NP_Name)      , pchar('OutputPipeReadThread'),
 
          TAG_END
 
        ]);
 
        // Some sanity check should be done here
 
  
        ErrorPipeReadThread := CreateNewProcTags
+
            Case Res of            // < 0 -> doserror  // = 0 -> endoffile // > 0 -> ok, bufferlength
        ([
+
              -2147483648 .. -1 :   // DosError
          LONG(NP_ENTRY)     , @ReadPipeErrorThread,
+
                begin
          LONG(NP_Priority) , 1,
+
                  WriteStr(S, 'OUT: ', S);
          LONG(NP_Name)     , pchar('ErrorPipeReadThread'),
+
                  Writeln(S);
          TAG_END
+
                  AddString(StringCollector, S);
        ]);
+
                end;
        // Some sanity check should be done here
+
                              0 :  // End Of File
 +
                begin
 +
                  writestr(S, 'OUT: EOF');
 +
                  AddString(StringCollector, S);
 +
                end;
 +
              1 .. 2147483647  :  // ok, represent length of buffer
 +
                begin
 +
                  AddString(StringCollector, S);
 +
                end;
 +
              else               
 +
                begin
 +
                  Writeln('OUT: Unexpected Error');
 +
                end;
 +
            end; // case
 +
          end;  // OutPipe.EOFReached
  
        writeln('RUNCMD(): Pipes (Output and Error) created');
+
          //
        // This loop will wait for both processes to be terminated
+
          // Handle ErrorPipe
        // which is true if CommandHasEnded is set to true.
+
          //
        // Be aware that using variables like CommandHasEnded
+
          If not ErrorPipe.EOFReached then //if not ErrorPipeDone then
        // (which addressed by multiple threads) in the way used
+
          begin
        // here is _very_ naughty. You are not allowed to share
+
            Res := ReadFromPipe(ErrorPipe, S);
        // variables amongst different threads this way.
+
           
        //
+
            Case Res of  // < 0 -> doserror // = 0 -> endoffile  // > 0 -> ok, bufferlength
        // Actually this loop does nothing, but could be used
+
              -2147483648 .. -1 :  // DosError
        // for other things that need attention. Using the
+
                begin
        // Output and error thread to fill some sort of FiFo-
+
                  WriteStr(S, 'ERR: ', S);
        // buffer that get's read in this loop comes to mind,
+
                  Writeln(S);
        // for example.
+
                  AddString(StringCollector, S);
        Writeln('RUNCMD(): Entering main loop, waiting for Output and Error thread to exit');
+
                end;
        while true do
+
                              0 :  // End Of File
        begin
+
                begin
          dec(limitcount);
+
                  writestr(S, 'ERR: EOF');
          if limitcount < 0 then limitcount := maxlimitcount;
+
                  Writeln(S);
 +
                  AddString(StringCollector, S);
 +
                end;
  
          If CommandHasEnded then break;
+
              1 .. 2147483647  :  // ok, represent length of buffer
          // just some delay and feedback for when the command takes a
+
                begin
          // long time to be executed. That way there is at least _some_
+
                  AddString(StringCollector, S);
          // feedback if the command does not actually output something
+
                end;
          // (for a long time) that can be catched by either one of the
+
              else               
           // read-threads.
+
                begin
 +
                  Writeln('ERR: Unexpected Error');
 +
                end;
 +
            end;  // case
 +
           end;  // ErrPipe.EOFReached
  
           // Here, one could also try to kill the task that is running
+
           // Assume that executed command is finished when both Pipes are
           // the shellcommand being executed, signals could be send etc.
+
           // reporting EOF. (which might be a totally wrong assumption)
          DosDelay(1);  // all we do here, is a useless wait().
+
           CommandHasEnded := (OutPipe.EOFReached and ErrorPipe.EOFReached);
           if limitcount = maxlimitcount then writeln('.');
 
 
         end;
 
         end;
         DOSClose(OutPipeRead);
+
          
        DOSClose(ErrorPipeRead);
+
       end;
       end
 
      else writeln('RUNCMD(): ERROR - Failed to open pipe(s) for read acces');
 
 
     end
 
     end
 
     else writeln('RUNCMD(): ERROR - Failed to execute command');
 
     else writeln('RUNCMD(): ERROR - Failed to execute command');
     // DOSClose(OutPipeWrite);
+
 
     // DOSClose(ErrorPipeWrite);
+
    // Write Handles are closed automatically for us, but we need to take
 +
     // care of the read handles ourselves.
 +
    DOSClose(OutPipe.ReadHandle);
 +
     DOSClose(ErrorPipe.ReadHandle);
 +
 
   end
 
   end
   else writeln('RUNCMD(): ERROR - Failed to open pipe(s) for write acces');
+
   else writeln('RUNCMD(): ERROR - Failed to open pipe(s) for read/write acces');
 +
 
 
end;
 
end;
  
  
 +
 +
Procedure RunCommand(CommandToRun: String; RCMode: TRCMode);
 +
Var
 +
  OutPipe      : TPipeSettings =
 +
  (
 +
    PipeName    : 'PIPE:*';
 +
    ReadHandle  : nil;
 +
    WriteHandle : nil;
 +
    EOFReached  : false;
 +
  );
  
Procedure RunCommand(CommandToRun: String; RCMode: TRCMode);
+
  ErrorPipe    : TPipeSettings =
 +
  (
 +
    PipeName    : 'PIPE:*';
 +
    ReadHandle  : nil;
 +
    WriteHandle : nil;
 +
    EOFReached  : false;   
 +
  );
 +
 
 
begin
 
begin
 
   writeln('enter - runcommmand');
 
   writeln('enter - runcommmand');
 
+
 
   case RCMode of
 
   case RCMode of
 
//    rcm_output  : RunCMDOutput(CommandToRun);
 
//    rcm_output  : RunCMDOutput(CommandToRun);
 
//    rcm_combined : RunCMDCombined(CommandToRun);
 
//    rcm_combined : RunCMDCombined(CommandToRun);
     rcm_Both    : RunCMDBoth(CommandToRun);
+
     rcm_Both    :  
 +
    begin
 +
      RunCMDBoth(CommandToRun, OutPipe, ErrorPipe);
 +
    end;
 
   end; // case;
 
   end; // case;
 
+
 
   writeln('leave - runcommmand');
 
   writeln('leave - runcommmand');
 
end;
 
end;
 +
  
 
+
 
(*
 
(*
 
       MAIN
 
       MAIN
 
*)
 
*)
 
var
 
var
   i : integer;
+
   i   : integer;       // simple counter/index
   S : String = '';
+
   c2e : String = '';   // Command To Execute
 
+
  SList : TStringList;  // Used to print out output for user
 +
 
begin
 
begin
 
   writeln('enter');
 
   writeln('enter');
 
+
   if paramcount > 0 then
+
  StringCollector := TMemoryStream.Create;
 +
 +
   if (paramcount > 0) then
 
   begin
 
   begin
 
     for i := 1 to paramcount
 
     for i := 1 to paramcount
       do S := S + ParamStr(i) + ' ';
+
       do c2e := c2e + ParamStr(i) + ' ';
     writeln('Trying to execute command "',S,'"');
+
     writeln('Trying to execute command "', c2e ,'"');
  
     RunCommand(S, rcm_both);
+
     RunCommand(c2e, rcm_both);
 
   end
 
   end
 
   else    // Show usage/examples
 
   else    // Show usage/examples
 
   begin
 
   begin
     Writeln('RunCMDoe v0.1');
+
     Writeln('RunCMDoe v0.6');
 
     Writeln;
 
     Writeln;
 
     Writeln('usage:');
 
     Writeln('usage:');
Line 636: Line 681:
 
     Writeln;
 
     Writeln;
 
   end;
 
   end;
 +
 +
 +
  // print results from the pipe to user
 +
  // which is usually done at run-time and
 +
  // not after the fact like is shown here.
 +
 
 +
  writeln('=================================');
 +
  writeln('Output/Error dump');
 +
  writeln('================================='); 
 +
 +
  // lazy solution for printing out memorystream.
 +
  SList := TStringList.Create;
 +
 +
  StringCollector.Position := 0;
 +
  SList.LoadFromStream(StringCollector);
 +
 +
  // write loop
 +
  for i := 0 to pred(SList.Count)
 +
    do writeln(SList[i]);
 +
 +
  SList.Free;
 +
 +
  writeln('================================='); 
 +
  writeln('================================='); 
 +
 +
  StringCollector.Free;
  
 
   writeln('leave');
 
   writeln('leave');
 
end.
 
end.
 
</source>
 
</source>

Latest revision as of 12:53, 20 December 2014

This documentation will first of all focus on running a command using the shell and doing so in an asynchrone matter. At the same time it tries to catch the output of that executed command, using the pipefs handler in AROS.

Caveats: There is little documentation at all concerning this topic, let alone for AROS in specific. So, whenever there is some documentation, you have to read that literally and fill in the blanks yourself. Hopefully this documentation is able to fill in some of those blanks.

Introduction

As can be read in the AutoDocs, the SystemTagList() function provides a way to execute a command via the shell. But what is not so evident, is that there are some caveats as well as some undocumented features that are not very well described.

Parameters

Let's start with the parameters that can be passed to this function.


The tags

Standard tags

SYS_Input - BPTR to pFileHandle
SYS_Output - BPTR to pFileHandle
SYS_Asynch - BOOL
SYS_UserShell - BPTR
SYS_CustomShell - STRPTR

Aros extensions

SYS_Error - BPTR to pFileHandle
SYS_ScriptInput - BPTR to pFileHandle
SYS_Background - BOOL
SYS_CliNumPtr - pLONG

Since these tags are passed through to CreateNewProc() you can also use tags that can be passed to that function, except those that conflict with SystemTagList() (the ones conflicting are striked).

Standard tags

NP_Seglist
NP_FreeSeglist
NP_Entry
NP_Input
NP_Output
NP_CloseInput
NP_CloseOutput
NP_Error
NP_CloseError
NP_CurrentDir - BPTR to pFileHandle
NP_StackSize - ULONG
NP_Name - STRPTR
NP_Priority - LONG
NP_ConsoleTask - APTR
NP_WindowPtr - pWindow
NP_HomeDir
NP_CopyVars, BOOL
NP_Cli
NP_Path, APTR
NP_CommandName - STRPTR
NP_Arguments
NP_NotifyOnDeath, BOOL
NP_Synchronous
NP_ExitCode - APTR
NP_ExitData - APTR

Aros extensions

NP_UserData

Piping

Asynchronous piping with AROS using pipefs: can only be done following strict rules, not following those rules simply breaks your code.

First of all in asynchronous mode, you cannot use an exclusive lock on the pipehandle. The ideal situation for reading and writing simultanously from and into the pipehandler would require that the writing end opens the handle in shared write mode, and the recieving reading end should use a shared read mode.

A close inspection at the documentation reveals that this leaves only one single possibilty when using normal DOSOpen functionality, namely opening the writing-end in MODE_READWRITE and the reading recieving end should open the handle in MODE_OLDFILE. At first one would think that the recieving reading end could also open the handle in MODE_READWRITE (which would give the revieving end write acces to the handle as well), but there is a little caveat revealed in the pipe: documentation:

102 Pipes behave in most respects like ordinary files.  Some differences follow:
103 Pipes block for writing (i.e., the write request is suspended) when the
104 pipe's buffer is full, and block for reading when the pipe's buffer is
105 empty.  Thus, pipes are sort of like bounded ram: files.  EOF is returned
106 for reading when the pipe's buffer is empty and no process has the pipe
107 open for writing.

Which, in case one would open the receiving end in MODE_READWRITE, would render the pipe-handle unusable as the last read-command done on the pipe-handle would let that read-command wait forever until no-one (in this case the receiving-end itself) has the handle open for writing. The only way that somewhat solves this, is using the NP_ExitCode tag and in that called code, close the pipe-handle of the receiving end (in order to let the receiver's last read command 'unlock' so it can continue. But by doing so, it would also make the receiver's routine useless as it has no acces to the pipe-handler anymore. Besides that, the last read done by the recieving-end with the last read on the handle would also contain garbled values towards the end of what the last read tells that was possible to read (as some functions return how many bytes/characters were read).

NOTE: As of abi-v0-on-trunk becoming mainstream abi-v0 (sep 2014), the above information isn't correct anymore. Use PIPE: device to handle your piped buffers. As a result, things behave more (if not completely) consistent with amigaOS 3.x pipe: device and handler.

How to use SystemTagList() in practise

Executing shell commands using SystemTagList():


Synchrone

[insert explanation here] [insert example here]

Synchrone and hidden

[insert explanation here] [insert example here]

Synchrone, hidden and catching Output

[insert explanation here] [insert example here]

Synchrone, hidden, catching Output as well as Errors

[insert explanation here] [insert example here]

Executing Asynchrone and catching Output.

[insert more information here]

It took me a while to figure out that when using pipefs, i read all about buffers and pipe being buffered. So i didn't figure at first, that using buffered reads/writes would mess up things. Only when i started to use unbuffered reads/writes i was getting somewhere and got things to work. Ofcourse milage may vary in/for different situations.

note: The parameterlist in NP_ExitCode routine is uncertain, so procedure CMDExitCode() could contain parameters based on what actually is being passed to it. Unfortunately i could only find one(!?) program using NP_ExitCode in AROS sourcetree, that used these exact parameters. But it could be possible that SegList Parameter is only passed when using this specific tag, just as NP_ExitData would perhaps add another parameter being passed to the procedure.

Program RunCMDoo;

{
  Name   : RunCMDoo V0.1
  Target : AROS ABIv0/i386
  Author : n/a
  Date   : 2013-09-15
  Goal   : Run a command using SystemTagList() and catch its output
  Usage  : RunCMDoo Command "[parameter1 parameter2 parameterN]"
}


{$MODE OBJFPC}{$H+}


Uses
  exec, amigados, utility, tagsarray;


Type
  BPTR              = LongInt;  // Quick fix to compensate for pointer

  TRCMode           =
  (
    rcm_output,     // Only use SYS_Output
    rcm_combined,   // Use Sys_Output and Sys_Error using the same handle.
                    // (impossible using SystemTagList() ?)
    rcm_both        // use SYS_Output and Sys_Error both using their own handle.
                    // (currently   bugs)
  );

Var
  CommandHasEnded   : boolean = false;
  CommandExitCode   : longint = 0;
  CommandSegList    : BPTR    = 0;

Var
  OutPipeRead       : BPTR;
  OutPipeWrite      : BPTR;

Const
  OutPipeName       = 'PIPEFS:CmdOut';  // Name should be randomized or use * (* = untested)



Procedure CMDExitCode(retcode: LongInt; SegList: BPTR); cdecl;
begin
  Writeln('Enter - MyExitCode()');

  CommandHasEnded := true;
  CommandExitCode := retcode;
  CommandSegList  := SegList;

  Writeln('MyExitCode(): exitcode =', CommandExitCode);
  Writeln('MyExitCode(): seglist  =', CommandSegList);
  
  Writeln('Leave - MyExitCode()');
end;


  
Procedure RunCMDOutput(CommandToRun: String);
var
  TagsList       : TTagsList = nil;
  Tags           : pTagItem;
  res            : LongInt;
  nread          : LongInt;
  OutPipeBuffer  : packed array[0..255] of char;
begin
  OutPipeWrite  := DosOpen( OutPipeName , MODE_READWRITE);

  if (OutPipeWrite <> 0) then
  begin
    addtags(TagsList,
    [
      LONG(SYS_Input)       , nil,

      LONG(SYS_Output)      , OutPipeWrite,
      LONG(NP_CloseOutput)  , 1,

      LONG(SYS_Error)       , nil,

      LONG(SYS_Asynch)      , 1,
      LONG(SYS_BackGround)  , 1,
      LONG(NP_ExitCode)     , @CMDExitCode,
      TAG_DONE
    ]);
    Tags := GetTagPtr(TagsList);

    writeln('RUNCMD(): Executing SystemTagList()');
    res := SystemTagList(CommandToRun, Tags);
    If (res <> -1) then
    begin
      writeln('RUNCMD(): SystemTagList() returned value ', res);
      writeln('RUNCMD(): opening OutPipe for reading');
      OutPipeRead   := DosOpen( OutPipeName   , MODE_OLDFILE);

      if (OutPipeRead <> 0) then
      begin
        writeln('RUNCMD(): entering main loop for reading data from OutPipe');
        while true do
        begin
            writeln('RUNCMD(): start a buffer read from OutPipe');
            nread := DosRead(OutPipeRead, @OutPipeBuffer[0], 255);
            // -1 = error, 0 = EOF and >0 = number of bytes actually read.
            if (nread <> -1) then
            begin
              writeln('RUNCMD(): buffer read from OutPipe was succesfull');
              OutPipeBuffer[nread] := #0;
              writeln(pchar(OutPipeBuffer));
              if (nread < 255) then break;
            end
            else
            begin
              writeln('RUNCMD(): ERROR - buffer read failed, IoErr() = ', IoErr);
              break;
            end;
            // Safety check ?
            if CommandHasEnded then Break;
        end;
        writeln('RUNCMD(): exiting main loop that read data from OutPipe');
        // Close our Output Pipe reader.
        DOSClose(OutPipeRead);
      end
      else writeln('RUNCMD(): ERROR - Failed to open pipe for read acces');
    end
    else writeln('RUNCMD(): ERROR - Failed to execute command');
    // close outputwrite when error occurend when executing systemtags()
  end;
end;



Procedure RunCommand(CommandToRun: String; RCMode: TRCMode);
begin
  writeln('enter - runcommmand');

  case RCMode of
    rcm_output   : RunCMDOutput(CommandToRun);
//    rcm_combined : RunCMDCombined(CommandToRun);
//    rcm_Both     : RunCMDBoth(CommandToRun);
  end; // case;

  writeln('leave - runcommmand');
end;



(*
    MAIN
*)
var
  i : Integer;
  S : String = '';

begin
  writeln('enter');

  If paramcount > 0 then
  begin
    for i := 1 to paramcount
      do S := S + Paramstr(i) + ' ';
    Writeln('Trying to execute command "',S,'"');

    RunCommand(S, rcm_Output);
  end
  else     // Show usage/examples
  begin
    Writeln('RunCMDoo v0.1');
    Writeln;
    Writeln('usage:');
    Writeln('  RunCMDoo Command [Parameter1 Paramere2 ParamterN]');
    Writeln;
    Writeln('example:');
    Writeln('  RunCMDoo LD --help');
    Writeln('  RunCMDoo LD --wrong_parameter_on_purpose');
    Writeln('  RunCMDoo LD -v');
    Writeln('  RunCMDoo dir ram:#?');
    Writeln;
  end;
  
  writeln('leave');
end.

Executing Asynchrone and catching Output as well as Error

[insert explanation here]


Problems encountered:

  • Unable to determine which pipe needs to be read first, so in the end one would always end up in a deadlock because not knowing what comes first OutPut or Error. Choosing the wrong one would make you wait forever and can only be 'broken' by reading the other pipe (flushing did not help).
  • Unable to use WaitForChar() as pipes are not in raw mode
  • seems not possible to change the mode using SetMode() (returns error)
  • unable to use fib for size of pipe as a pipe-file is always zero
  • Seek() function does not seem to work on pipes, again unable to determine size
  • unable to glue/merge OutPut and Error together as SystemTaglist() automatically (no override possible) closes the Output and Error handle. Since the handles are the same (when glued/merged) it would result in a memory freed twice error (amongst others).

Solution used: using multiple threads.

Code presented here is not thorouogly tested and probably contains loads of errors and/or other not so obvious things as well. At least it runs, but feel free to correct of give some pointers.

program RunCMDoe;
 
{
  Name   : RunCMDoe V0.6
  Target : AROS ABIv0/i386
  Author : Molly
  Date   : 2014-12-20
  Goal   : Run a command using SystemTagList() and catch its output and error
  usage  : RunCMDoe Command [parameter1 parameter2 parameterN]
  Note   : Code only tested on 'simple' commands. Not tested against
           commands that produces multiple consecutive output and error
           messages.

  Important Information:
  abi_v0_on_trunk brings improvements: 
  PipeFS: seems gone, use Pipe: instead also "*" works now.
  The Pipe: device seems to work identical as on classic.
}

 
{$MODE OBJFPC}{$H+}
 
 
uses
  classes, exec, amigados, utility, tagsarray;



type
  TRCMode           =
  (
    rcm_output,     // Only use SYS_Output
    rcm_combined,   // Use Sys_Output and Sys_Error using the same handle.
    rcm_both        // use SYS_Output and Sys_Error both using their own handle.
  );


  TPipeSettings     = record    
    PipeName        : String;
    ReadHandle      : BPTR;
    WriteHandle     : BPTR;
    EOFReached      : boolean;
  end; 

 
var
  CommandHasEnded   : boolean = false;
  CommandExitCode   : longint = 0;
  CommandSegList    : BPTR    = nil;
 
  StringCollector   : TMemoryStream;
 


// ==========================================================================
// routine to add a String to a memorystream
// ==========================================================================
Procedure AddString(M: TMemoryStream; S: String);
var i: integer;
begin
  For i := 1 to length(S) do M.WriteByte(Byte(S[i]));
end;


 
// ==========================================================================
// return function provided to SystemTagsList 
// ==========================================================================
Procedure CMDExitCode(retcode: LongInt; SegList: BPTR); cdecl;
var
  ops : Text;
begin
  CommandHasEnded := true;

  ops := System.Output;
  Writeln(ops, 'Enter - CMDExitCode()');

  CommandExitCode := retcode;
  CommandSegList  := SegList;
 
  Writeln(ops, 'CMDExitCode(): exitcode =', CommandExitCode);
  Writeln(ops, 'CMDExitCode(): seglist  =', LongWord(CommandSegList));
 
  Writeln(ops, 'Leave - CMDExitCode()');
end;
 


//
//  Creates an actual pipe-buffer from supplied PipeConfig, and returns
//  true when succeeded
//
Function CreatePipeLink(var APipe: TPipeSettings): boolean;
Var 
  NameBuf         : Packed array[0.. 63] of Char;
begin
  Result := false;

  APipe.ReadHandle  := nil;
  APipe.WriteHandle := nil;
  
  APipe.WriteHandle := DosOpen( PChar(APipe.PipeName), MODE_NEWFILE);
  If (APipe.WriteHandle = nil) then exit;

  if Not (NameFromFH (APipe.WriteHandle, NameBuf, Sizeof(NameBuf))) then exit;
  APipe.PipeName    := NameBuf;  // copy real name
  
  APipe.ReadHandle  := DosOpen(NameBuf, MODE_OLDFILE);
  If (APipe.ReadHandle = nil) then exit;

  result := true;
end;



//
// read data from given APipe and return a value indicating state of read
// return value:
// 0   = EOF
// < 0 = error
// > 0 = nt of characters returned in RetBug
//
function ReadFromPipe(var APipe: TPipeSettings; Var RetBuf: String): LongInt;
var
  RDBuffer  : packed array[0..63] of char;
  PRDBuffer : Pchar;
  ThisErr   : LongInt;
  fib       : TFileInfoBlock;
begin
  // some small debug info
  If ExamineFH(APipe.Readhandle, @fib)
  then writeln('bytes in buffer = ', fib.fib_size);

  PRDBuffer := @RDBuffer[0];
  RetBuf    := '';

  // According to RKRM:
  // If FGets()'s returned buffer nil, either error or EOF occured.
  // If ioErr() = 0 then EOF else error-code.
  // error-codes are not handled appropriately in this code

  if FgetS(APipe.ReadHandle, PRDBuffer, Sizeof(RDBuffer)) <> nil then
  begin
    RetBuf := StrPas(PRDBuffer);
    Result := Length(RetBuf);
  end
  else
  begin
    ThisErr := amigados.IoErr;
              
    If ( ThisErr = 0 ) then
    begin
      RetBuf := '';
      APipe.EOFReached := True;
      Result := 0;
    end
    else
    begin
      WriteStr(RetBuf, 'DOS ERROR = ', ThisErr);
      Result := -1;
    end;
    
  end;
end;



procedure RunCMDBoth(CommandToRun: String; var OutPipe: TPipeSettings; var ErrorPipe: TPipeSettings);
var
  TagsList      : TTagsList = nil;
  Tags          : pTagItem;
  res           : LongInt;
  S             : String = '';
begin
  If CreatePipeLink(OutPipe) and CreatePipeLink(ErrorPipe) then
  begin
    writeln('RUNCMD(): OK - opened pipe(s) for read/write acces');  
    addtags(TagsList,
    [
      LONG(SYS_Input)       , nil,
 
      LONG(SYS_Output)      , OutPipe.WriteHandle,
      LONG(NP_CloseOutput)  , 1,
 
      LONG(SYS_Error)       , ErrorPipe.WriteHandle,
      LONG(NP_CloseError)   , 1,
 
      LONG(SYS_Asynch)      , 1,
      LONG(SYS_BackGround)  , 1,
      LONG(NP_ExitCode)     , @CMDExitCode,
      TAG_DONE
    ]);
    Tags := GetTagPtr(TagsList);
 
    writeln('RUNCMD(): Executing SystemTagList()');
    res := SystemTagList(pchar(CommandToRun), Tags);
  
    If (res <> -1) then
    begin
      writeln('RUNCMD(): SystemTagList() returned value ', res);

      begin
        Writeln('RUNCMD(): Entering main loop, waiting for Output and Error thread to exit');
        
        //
        //  Main Loop for reading pipe-buffers
        //
        while not CommandHasEnded do
        begin

          //
          // Handle OutPipe
          //
          If not OutPipe.EOFReached then //if not OutPipeDone then
          begin
            Res := ReadFromPipe(OutPipe, S);

            Case Res of             // < 0 -> doserror  // = 0 -> endoffile // > 0 -> ok, bufferlength
              -2147483648 .. -1 :   // DosError
                begin
                  WriteStr(S, 'OUT: ', S);
                  Writeln(S);
                  AddString(StringCollector, S);
                end;
                              0 :   // End Of File
                begin
                  writestr(S, 'OUT: EOF');
                  AddString(StringCollector, S);
                end;
              1 .. 2147483647   :   // ok, represent length of buffer
                begin
                  AddString(StringCollector, S);
                end;
              else                
                begin
                  Writeln('OUT: Unexpected Error');
                end;
            end;  // case
          end;  // OutPipe.EOFReached

          //
          // Handle ErrorPipe
          //
          If not ErrorPipe.EOFReached then //if not ErrorPipeDone then
          begin
            Res := ReadFromPipe(ErrorPipe, S);
            
            Case Res of   // < 0 -> doserror // = 0 -> endoffile  // > 0 -> ok, bufferlength
              -2147483648 .. -1 :   // DosError
                begin
                  WriteStr(S, 'ERR: ', S);
                  Writeln(S);
                  AddString(StringCollector, S);
                end;
                              0 :   // End Of File
                begin
                  writestr(S, 'ERR: EOF');
                  Writeln(S);
                  AddString(StringCollector, S);
                end;

              1 .. 2147483647   :   // ok, represent length of buffer
                begin
                  AddString(StringCollector, S);
                end;
              else                
                begin
                  Writeln('ERR: Unexpected Error');
                end;
            end;  // case
          end;  // ErrPipe.EOFReached

          // Assume that executed command is finished when both Pipes are 
          // reporting EOF. (which might be a totally wrong assumption)
          CommandHasEnded := (OutPipe.EOFReached and ErrorPipe.EOFReached);
        end;
        
      end;
    end
    else writeln('RUNCMD(): ERROR - Failed to execute command');

    // Write Handles are closed automatically for us, but we need to take
    // care of the read handles ourselves.
    DOSClose(OutPipe.ReadHandle);
    DOSClose(ErrorPipe.ReadHandle);
 
  end
  else writeln('RUNCMD(): ERROR - Failed to open pipe(s) for read/write acces');
  
end;


 
Procedure RunCommand(CommandToRun: String; RCMode: TRCMode);
Var
  OutPipe       : TPipeSettings =
  (
    PipeName    : 'PIPE:*';
    ReadHandle  : nil;
    WriteHandle : nil;
    EOFReached  : false;
  );

  ErrorPipe     : TPipeSettings =
  (
    PipeName    : 'PIPE:*';
    ReadHandle  : nil;
    WriteHandle : nil;
    EOFReached  : false;    
  );
  
begin
  writeln('enter - runcommmand');
 
  case RCMode of
//    rcm_output   : RunCMDOutput(CommandToRun);
//    rcm_combined : RunCMDCombined(CommandToRun);
    rcm_Both     : 
    begin
      RunCMDBoth(CommandToRun, OutPipe, ErrorPipe);
    end;
  end; // case;
 
  writeln('leave - runcommmand');
end;
 

 
(*
      MAIN
*)
var
  i   : integer;        // simple counter/index
  c2e : String = '';    // Command To Execute
  SList : TStringList;  // Used to print out output for user
 
begin
  writeln('enter');
 
  StringCollector := TMemoryStream.Create;
 
  if (paramcount > 0) then
  begin
    for i := 1 to paramcount
      do c2e := c2e + ParamStr(i) + ' ';
    writeln('Trying to execute command "', c2e ,'"');

    RunCommand(c2e, rcm_both);
  end
  else    // Show usage/examples
  begin
    Writeln('RunCMDoe v0.6');
    Writeln;
    Writeln('usage:');
    Writeln('  RunCMDoe Command [Parameter1 Parameter2 ParameterN]');
    Writeln;
    Writeln('example:');
    Writeln('  RunCMDoe LD --help');
    Writeln('  RunCMDoe LD --wrong_parameter_on_purpose');
    Writeln('  RunCMDoe LD -v');
    Writeln('  RunCMDoe dir ram:#?');
    Writeln;
  end;


  // print results from the pipe to user
  // which is usually done at run-time and
  // not after the fact like is shown here.
  
  writeln('=================================');
  writeln('Output/Error dump');
  writeln('=================================');  

  // lazy solution for printing out memorystream.
  SList := TStringList.Create;

  StringCollector.Position := 0;
  SList.LoadFromStream(StringCollector);

  // write loop
  for i := 0 to pred(SList.Count)
    do writeln(SList[i]);

  SList.Free;

  writeln('=================================');  
  writeln('=================================');  
 
  StringCollector.Free;

  writeln('leave');
end.