{*
 *  xsh.tml
 *
 *  Micro shell program for OS-X
 *  X-tended version with many built in programs
 *
 *  Revision history:
 *    941017 Francis Gormarker, original OS-X black box version.
 *
 *    950828 FrGo, modified for Z80 emulator, delays are removed.
 *}

UNIT sh;

INTERFACE

  PROCEDURE toploop();

IMPLEMENTATION

 uses
   sys_rpc,
   sys,
   memory,
   output,
   input;

 const
   stdin     = 0;
   stdout    = 1;
   stderr    = 2;
   version   = "Extended command shell ver 98-05-28";

 var
   ignore       : int;
   client       : int;

   fg_child : int;
   offset   : int;
   argn     : int;
   arg      : array[16] of ^string;
   argbuf   : array[256] of char;

   _path_   : array[64] of char;  { Current search path }
   _prompt_ : array[16] of char;  { Current prompt string }
   line{,s}   : string;
   {mask     : string;}
   {cbuf     : array[255] of char;}
   cbuf      : array[220] of char;


  PROCEDURE stat(path: string; buf: ^fattr_t): int;
   var
     result : int;
     server : int;
     ufid   : ufid_t;
     fmsg   : ^file_message;
     msg    : dir_message2;
  BEGIN
    result := rlookup(path,@ufid);
    if result = 0 then
       fmsg := @msg;
       fmsg^.ufid := ufid;
       {putln("stat(""",path,""") => ufid.server=",ufid.server);}
       server := chkdst(ufid.server);
       result := rpc_call(mod_filed,file_getAttr,@msg,buf,server,sizeof(file_message2),0,sizeof(fattr_t),rpc_timeout);
    end;
    return result;
  END stat;


  PROCEDURE statfs(path: string; buf: ^fs_info_t): int;
   var
     result : int;
     server : int;
     ufid   : ufid_t;
     fmsg   : ^file_message;
     msg    : dir_message2;
  BEGIN
    result := rlookup(path,@ufid);
    if result = 0 then
       fmsg := @msg;
       fmsg^.ufid := ufid;
       server := chkdst(ufid.server);
       result := rpc_call(mod_filed,file_getStat,@msg,buf,server,sizeof(file_message2),0,sizeof(fs_info_t),rpc_timeout);
    end;
    return result;
  END statfs;


  FUNCTION append(var s1: string; s2: string; max: int);
   var
     i,j : int;
  BEGIN
    i := 1;
    j := length(s1) + 1;
    while (i <= length(s2)) and (j+1 < max) loop
       s1[j] := s2[i];
       inc(i);
       inc(j);
    end loop;
    length(s1) := j-1;
  END append;


  { Return true if name matches the mask string }

  PROCEDURE match(name,mask: string): boolean;
   var
     j,k  : int;
     ok   : boolean;
  BEGIN
    if name[1] = '.' then
       { Filter out all files that begins with a period }
       return false;
    end;
    ok := true;
    if (length(mask) <> 0) and (mask[1] = '*') then
       { Match suffix }
       j := length(mask);
       for k := length(name) while ok and (j <> 0) and (k <> 0) do dec(k) loop
           if mask[j] = '*' then
              return true;
           else
              ok := mask[j] = name[k];
              dec(j);
           end;
       end loop;
       return ok and (j = 0) and (k = 0);
    else
       { Match prefix }
       j := 1;
       for k := 1 while ok and (j <= length(mask)) and (k <= length(name)) do inc(k) loop
           if mask[j] = '*' then
              return true;
           else
              ok := mask[j] = name[k];
              inc(j);
           end;
       end loop;
       return ok and (j >= length(mask)) and (k >= length(name));
    end;
  END match;


  PROCEDURE is_wildcard(s: string): boolean;
   var
     i    : int;
     star : boolean;
  BEGIN
    star := false;
    for i := 1 while i <= length(s) do inc(i) loop
        star := star or (s[i] = '*');
    end;
    return star;
  END;


  FUNCTION val(s: string): int;
   var
     i,sum : int;
  BEGIN
     sum := 0;
     i := 1;
     while i <= length(s) loop
        sum := sum * 10 + int(s[i] - '0');
        inc(i);
     end loop;
     return sum;
  END val;


  FUNCTION scan(source: string; var dest: string; var pos: int);
    var
      len,i     : int;
      breakchar : char;
  BEGIN
    len := length(source);
    while (pos <= len) and (source[pos] = ' ') loop
       inc(pos);
    end loop;
    i := 1;
    if source[pos] = ''' then
       breakchar := ''';
       inc(pos);
       dest[1] := ''';
       i := 2;
    else
       breakchar := ' ';
    end;
    while (pos <= len) and (source[pos] <> breakchar) loop
       if i < 127 then
          dest[i] := source[pos];
          inc(i);
       end;
       inc(pos);
    end loop;
    inc(pos);
    length(dest) := i-1;
  END scan;


  PROCEDURE clear_args();
  BEGIN
    offset := 0;
    argn := 0;
  END;


  PROCEDURE add_arg(s: string);
   var
     len : int;
  BEGIN
    len := length(s) + 1;
    if (argn < 16) and (offset+len < 200) then
       arg[argn] := @argbuf[offset];
       {
       if argn = 0 then
          { Reserve 40 bytes for arg[0] }
          len := 40;
       end;
       }
       inc(argn);
       copy(@s,@argbuf[offset],len);
       offset := offset + len;
    end;
  END;


  PROCEDURE kill_process(host,id: int): int;
   var
     msg : proc_message2;
  BEGIN
    msg.id := id;
    return rpc_call(mod_procd,proc_kill,@msg,nil,host + kernel_port,sizeof(proc_message2),0,0,rpc_timeout);
  END;


  PROCEDURE pstat(host,id: int; buf: ^pstatbuf): int;
   var
     msg : proc_message2;
  BEGIN
    msg.id := id;
    return rpc_call(mod_procd,proc_pstat,@msg,buf,host + kernel_port,sizeof(proc_message2),0,sizeof(pstatbuf),rpc_timeout);
  END;


  const
    crlf : string = (#2,#13,#10);


  PROCEDURE perror(module,msg1,msg2: string);
  BEGIN
    fputs(stderr,module);
    fputs(stderr,msg1);
    fputs(stderr,msg2);
    fputs(stderr,crlf);
  END;


  PROCEDURE do_ps();
   var
     i     : int;
     host  : int;
     short : boolean;
     buf   : pstatbuf;
  BEGIN
    host := 0;
    i := 1;
    short := false;
    if argn >= 2 then
       short := arg[1]^ = "-p";
       if arg[1]^[1] = '-' then
          inc(i);
       end;
       if i < argn then
          host := val(arg[i]^);
          putln("ps: host=",host);
       end;
    end;
    if short then
       putln("  PID   NAME");
    else
       putln("  PID   STAT  PRI  MAP   SIZE   SSEG     SP  NAME");
    end;
    for i := 0 while pstat(host,i,@buf) = 0 do inc(i) loop
        if buf.status <> process_free then
           put(buf.id,"   ");
           if short then
              putln(string(buf.name));
              if getchar() = 3 then
                 return;
              end;
           else
              if buf.pseg = nil then
                 { Lightweight process }
                 put('L');
              else
                 put(' ');
              end;
              case buf.status of
                process_active     : put("R  ");
                process_waiting    : put("W  ");
                process_suspended  : put("S  ");
                process_terminated : put("T  ");
                else put("?  ");
              end case;
              put(int(buf.pri),int(buf.map),"  ",buf.psize,"  ");
              putln(int(buf.sseg),"  ",buf.sp,"  ",string(buf.name));
           end;
        end;
    end loop;
    putln();
  END do_ps;


  PROCEDURE do_ls(path: string; long,pause: boolean);
   var
     fd,n,i : int;
     wc     : boolean;
     s      : ^string;
     info   : fattr_t;
     name   : array[32] of char;
  BEGIN
    n := 0;
    putln("Directory of '",path,"'");
    wc := is_wildcard(path);
    if wc then
       fd := open("",0);
    else
       fd := open(path,0);
    end;
    if (fd = -1) or (ftype(fd) <> ftype_dir) then
       perror("ls: ",path,": couldn't open.");
    else
       n := read_dir(fd,@line,sizeof(line));
       while n <> 0 loop
          i := 0;
          while i < n loop
             s := @line[i];
             if (not wc) or match(s^,path) then
                if long then
                   if path <> "" then
                      name := path;
                      append(name,"/",32);
                      append(name,s^,32);
                   else
                      name := s^;
                   end;
                   if stat(name,@info) = 0 then
                      put(info.size,"  ");
                   else
                      put("?????  ");
                   end;
                end;
                putln(s^);
                if pause then
                   if getchar() = 3 then
                      close(fd);
                      return;
                   end;
                end;
             end;
             i := i + int(line[i]) + 1;
          end loop;
          n := read_dir(fd,@line,sizeof(line));
       end loop;
       close(fd);
    end;
    putln();
  END do_ls;


  PROCEDURE do_stat();
  BEGIN
      putln("Memory free:");
      putln(" [0] ",gmem_avail(#0),", ",gmem_max(#0));
      putln(" [1] ",gmem_avail(#1),", ",gmem_max(#1));
      putln(" [2] ",gmem_avail(#2),", ",gmem_max(#2));
      putln(" [3] ",gmem_avail(#3),", ",gmem_max(#3));
  END;


  PROCEDURE do_kill();
   var
     n,host : int;
  BEGIN
    n := val(arg[1]^);
    host := 0;
    if argn = 3 then
       host := val(arg[2]^);
       putln("kill: host=",host);
    end;
    if (argn >= 2) and (n > 2) then
       if kill_process(host,n) <> 0 then
          putln("kill: ",n,": no such process.");
       end;
    else
       putln("Usage: kill pid [ host_address ]");
    end;
  END do_kill;


  PROCEDURE do_pri();
   var
     id,pri : int;
  BEGIN
    if argn = 3 then
       id := val(arg[1]^);
       pri := val(arg[2]^);
       set_priority(id,pri);
       putln("pri: pid ",id,": priority set to ",pri);
    else
       putln("Usage: pri pid level");
    end;
  END do_pri;

  {
  PROCEDURE do_rpc();
   var
     server : int;
     result : int;
     msg    : rpc_header;
  BEGIN
    if argn = 3 then
       server := val(arg[2]^);
       if arg[1]^ = "shutdown" then
          result := rpc_call(#0,std_shutdown,@msg,nil,server,sizeof(rpc_header),0,0,rpc_timeout);
       elsif arg[1]^ = "restart" then
          result := rpc_call(#0,std_restart,@msg,nil,server,sizeof(rpc_header),0,0,rpc_timeout);
       else
          putln("rpc: ",arg[1]^,": unknown mode.");
          return;
       end;
       if result <> 0 then
          putln("rpc: RPC failed.");
       end;
    else
       putln("Usage: rpc [ restart | shutdown ] socket");
    end;
  END do_rpc;
  }


  { Display file system info }
 
  PROCEDURE do_df();
   var
     s    : ^string;
     info : fs_info_t;
  BEGIN
    s := get_cwd();
    if argn > 1 then
       s := arg[1];
    end;
    if statfs(s^,@info) = 0 then
       putln("fs_type     : ",info.fs_type);
       putln("free nodes  : ",info.free_nodes," (",info.nodes,')');
       putln("free blocks : ",info.free_blocks," (",info.blocks,')');
    else
       perror("df: ",s^,": couldn't stat.");
    end;
  END do_df;


  PROCEDURE do_fg();
   var
     n,status : int;
     buf      : pstatbuf;
  BEGIN
    n := val(arg[1]^);
    if argn <> 2 then
       perror("Usage: fg pid","","");
    else
       if restart(n) <> 0 then
          putln("fg: ",n,": cannot restart process.");
       else
          ignore := pstat(0,n and 255,@buf);
          status := join(n);
          case status and $f000 of
            exit_stopped : putln('[',n,"] ",string(buf.name),": stopped.");
            exit_killed  : putln('[',n,"] ",string(buf.name),": killed.");
          end case;
       end;
    end;
  END do_fg;


  PROCEDURE do_rsh();
   var
     child,host : int;
  BEGIN
    if argn < 3 then
       perror("Usage: rsh host_addr command { args }","","");
    else
       host := val(arg[1]^);
       child := exec(host,argn-2,@arg[2]);
       if  child = -1 then
          putln("rsh: ",arg[2]^,": cannot execute.");
       else
          putln('[',child,"] ",arg[2]^,", host=",host);
       end;
    end;
  END do_rsh;


  PROCEDURE do_rm();
   var
     i : int;
  BEGIN
    if argn = 1 then
       perror("Usage: rm file1 file2 ... fileN","","");
    else
       for i := 1 while i < argn do inc(i) loop
           if delete(arg[i]^) <> 0 then
              perror("rm: ",arg[i]^,": couldn't remove.");
           end;
       end loop;
    end;
  END do_rm;


  PROCEDURE do_cp();
   var
     src,dst,n   : int;
  BEGIN
    if argn <> 3 then
       perror("Usage: cp source target","","");
    else
       src := open(arg[1]^,o_read);
       if src = -1 then
          perror("cp: ",arg[1]^,": couldn't open.");
          return;
       end;
       dst := open(arg[2]^,o_write);
       if dst = -1 then
          perror("cp: ",arg[2]^,": couldn't create.");
          close(src);
          return;
       end;
       n := read(src,@cbuf,sizeof(cbuf));
       while n <> 0 loop
          if write(dst,@cbuf,n) <> n then
             perror("cp: ",arg[2]^,": write error.");
             close(src);
             close(dst);
             return;
          end;
          n := read(src,@cbuf,sizeof(cbuf));
       end loop;
       close(src);
       close(dst);
    end;
  END do_cp;


  PROCEDURE do_echo();
   var
     i : int;
  BEGIN
    for i := 1 while i < argn do inc(i) loop
       put(string(arg[i]^),' ');
    end loop;
    putln();
  END;


  PROCEDURE run_internal(buf: string): boolean;
   var
     n,i,fd : int;
     child  : int;
     long   : boolean;
     pause  : boolean;
  BEGIN
    if buf = "ls" then
       i := 1;
       long := false;
       pause := false;
       while (i < argn) and (arg[i]^[1] = '-') loop
          if arg[i]^ = "-l" then
             long := true;
          elsif arg[i]^ = "-p" then
             pause := true;
          end;
          inc(i);
       end loop;
       if i < argn then
          do_ls(arg[i]^,long,pause);
       else
          do_ls(get_cwd()^,long,pause);
       end;
    elsif buf = "rsh" then
       do_rsh();
    elsif buf = "pri" then
       do_pri();
    elsif buf = "cd" then
       set_cwd(arg[1]^);
    elsif buf = "rm" then
       do_rm();
    elsif buf = "fg" then
       do_fg();
    elsif buf = "echo" then
       do_echo();
    {
    elsif buf = "rpc" then
       do_rpc();
    }
    elsif buf = "df" then
       do_df();
    elsif buf = "cp" then
       child := fork(do_cp,512,nil,"cp");
       if child <> -1 then
          ignore := join(child);
       else
          putln("cp: couldn't fork.");
       end;
    elsif buf = "set" then
       if argn < 3 then
          putln("path=",string(_path_));
          putln("prompt=",string(_prompt_));
       elsif arg[1]^ = "path" then
          _path_ := arg[2]^;
       elsif arg[1]^ = "prompt" then
          _prompt_ := arg[2]^;
       end;
    elsif buf = "pwd" then
       putln(get_cwd()^);
    elsif buf = "mem" then
       do_stat();
    elsif buf = "exit" then
       putln("logout.");
       exit(0);
    {
    elsif buf = "reboot" then
       putln("Going down in 5 seconds...");
       hold(5000);
       loop
          lock();
          inline($C3,0,0);
       end loop;
    }
    elsif buf = "ps" then
       do_ps();
    {
    elsif buf = "cat" then
       fd := open(arg[1]^,o_read);
       if fd = -1 then
          perror("cat: ",arg[1]^,": couldn't open.");
       else
          n := read(fd,@cbuf[1],sizeof(cbuf));
          while n <> 0 loop
             length(cbuf) := n;
             put(string(cbuf));
             n := read(fd,@cbuf[1],sizeof(cbuf));
          end loop;
          close(fd);
          putln();
       end;
    }
    elsif buf = "help" then
       putln("Commands:");
       putln("  rm cd ls df cat ps pri kill fg rsh mem echo set pwd exit reboot");
    elsif buf = "kill" then
       do_kill();
    else
       return false;
    end;
    return true;
  END;


  PROCEDURE parse_args(line: string): boolean;
   var
     i,pos,j,n    : int;
     count,ignore : int;
     fd0,fd1      : int;
     f            : int;
     mask         : path_string;
     s            : path_string;
  BEGIN
    clear_args();
    i := 0;
    pos := 1;
    fd0 := -1;
    fd1 := -1;
    repeat
       scan(line,s,pos);

       if string(s) = "<" then
          scan(line,s,pos);
          if (length(s) > 0) and (fd0 = -1) then
             close(stdin);
             fd0 := open(s,o_read);
             if fd0 = -1 then
                perror("sh: ",string(s),": couldn't open.");
                return false;
             end;
          end;
       elsif string(s) = ">" then
          scan(line,s,pos);
          if (length(s) > 0) and (fd1 = -1) then
             close(stdout);
             fd1 := open(s,o_write);
             if fd1 = -1 then
                perror("sh: ",string(s),": couldn't open.");
                return false;
             end;
          end;
       elsif (length(s) > 0) and (s[1] = ''') then
          { Quoted argument }
          s[1] := char(length(s) - 1);
          add_arg(string(@s[1]));
          inc(i);
       elsif is_wildcard(s) then
          { expand wildcards }
          mask := s;
          f := open("",o_read);
          if (f = -1) or (ftype(f) <> ftype_dir) then
             putln("No match.");
             return false;
          end;
          count := 0;

          n := read_dir(f,@cbuf,sizeof(cbuf));
          while n <> 0 loop
             j := 0;
             while j < n loop
                s := string(@cbuf[j]);
                {
                if path <> "" then
                   name := path;
                   append(name,"/",32);
                   append(name,s,32);
                else
                   name := s;
                end;
                }
                if match(s,mask) and (i < 16) then
                   add_arg(s);
                   inc(count);
                   inc(i);
                end;
                j := j + int(cbuf[j]) + 1;
             end loop;
             n := read_dir(f,@cbuf,sizeof(cbuf));
          end loop;
          close(f);
          if count = 0 then
             putln("No match.");
             return false;
          end;
          s := " ";
       elsif length(s) > 0 then
          add_arg(s);
          inc(i);
       end;
    until (i >= 16) or (length(s) = 0);
    return true;
  END;


  PROCEDURE interpret(line: string; var err: int);
   var
     child,pos    : int;
     status       : int;
     f,sin,sout   : int;
     background   : boolean;
     name         : ^string;
     s            : array[40] of char;
  BEGIN
    sin := dup(stdin);
    sout := dup(stdout);
    child := -1;
    if parse_args(line) then
       background := false;
       if (argn > 1) and (arg[argn-1]^ = "&") then
          background := true;
          dec(argn);
          { Disconnect tty here ... }
       end;
       name := arg[0];
       if argn > 0 then
          if not run_internal(name^) then
             child := exec(0,argn,@arg);
             if name^[1] <> '/' then
                pos := 1;
                while (child = -1) and (pos < length(_path_)) loop
                   { Try search path too }
                   scan(_path_,s,pos);
                   append(s,"/",40);
                   append(s,name^,40);
                   arg[0] := @s;
                   child := exec(0,argn,@arg);
                end loop;
             end;
             if background then
                set_break(child,false);
             else
                { Save pid of foreground process }
                fg_child := child;
             end;
             if child = -1 then
                perror(name^,": command not found.","");
             end;
          end;
       end;
    end;
    { Restore std files }

    close(stdin);
    ignore := dup(sin);
    close(sin);
    close(stdout);
    ignore := dup(sout);
    close(sout);

    if child <> -1 then
       if background then
          { Reconnect tty here ... }
          putln('[',child,"] ",arg[0]^);
       else
          status := join(fg_child);
          case status and $f000 of
            exit_stopped : putln('[',fg_child,"] ", arg[0]^,": stopped.");
            exit_killed  : putln('[',fg_child,"] ", arg[0]^,": killed.");
          end case;
       end;
    end;
  END interpret;


  PROCEDURE toploop();
   var
     err,i,n,fd  : int;
  BEGIN
    set_break(idSelf(),false);
    set_priority(idSelf(),1);
    init_input();
    _path_ := "/bin";
    _prompt_ := "$cwd";
    putln();
    putln(version);
    loop
       if string(_prompt_) = "$cwd" then
          put(get_hostname()^,' ',get_cwd()^,'>');
       elsif string(_prompt_) = "$host" then
          put(get_hostname()^,'>');
       else
          put(string(_prompt_));
       end;
       line := "";
       getLine(line,60);
       interpret(line,err);
    end loop;
  END;


BEGIN
  toploop();
END sh;