home *** CD-ROM | disk | FTP | other *** search
/ Mac-Source 1994 July / Mac-Source_July_1994.iso / Other Langs / Tickle-4.0 (tcl) / tcl / extend / src.unused / tclXprocess.c < prev    next >
Encoding:
C/C++ Source or Header  |  1993-10-26  |  7.0 KB  |  257 lines  |  [TEXT/MPS ]
  1. /*
  2.  * tclXprocess.c --
  3.  *
  4.  * Tcl command to create and manage processes.
  5.  *-----------------------------------------------------------------------------
  6.  * Copyright 1991-1993 Karl Lehenbauer and Mark Diekhans.
  7.  *
  8.  * Permission to use, copy, modify, and distribute this software and its
  9.  * documentation for any purpose and without fee is hereby granted, provided
  10.  * that the above copyright notice appear in all copies.  Karl Lehenbauer and
  11.  * Mark Diekhans make no representations about the suitability of this
  12.  * software for any purpose.  It is provided "as is" without express or
  13.  * implied warranty.
  14.  *-----------------------------------------------------------------------------
  15.  * $Id: tclXprocess.c,v 2.8 1993/08/18 06:12:37 markd Exp $
  16.  *-----------------------------------------------------------------------------
  17.  */
  18.  
  19. #include "tclExtdInt.h"
  20.  
  21. /*
  22.  * These are needed for wait command even if waitpid is not available.
  23.  */
  24. #ifndef  WNOHANG
  25. #    define  WNOHANG    1
  26. #endif
  27. #ifndef  WUNTRACED
  28. #    define  WUNTRACED  2
  29. #endif
  30.  
  31.  
  32. /*
  33.  *-----------------------------------------------------------------------------
  34.  *
  35.  * Tcl_ExeclCmd --
  36.  *     Implements the TCL execl command:
  37.  *     execl prog ?argList?
  38.  *
  39.  * Results:
  40.  *  Standard TCL results, may return the UNIX system error message.
  41.  *
  42.  *-----------------------------------------------------------------------------
  43.  */
  44. int
  45. Tcl_ExeclCmd (clientData, interp, argc, argv)
  46.     ClientData  clientData;
  47.     Tcl_Interp *interp;
  48.     int         argc;
  49.     char      **argv;
  50. {
  51. #define STATIC_ARG_SIZE   12
  52.     char  *staticArgv [STATIC_ARG_SIZE];
  53.     char **argInList = NULL;
  54.     char **argList   = staticArgv;
  55.     int    argInCnt, idx;
  56.  
  57.     if ((argc < 2) || (argc > 3)) {
  58.         Tcl_AppendResult (interp, tclXWrongArgs, argv [0], 
  59.                           " prog ?argList?", (char *) NULL);
  60.         return TCL_ERROR;
  61.     }
  62.  
  63.     /*
  64.      * If arg list is supplied, split it and build up the arguments to pass.
  65.      * otherwise, just supply argv[0].  Must be NULL terminated.
  66.      */
  67.     if (argc > 2) {
  68.         if (Tcl_SplitList (interp, argv [2], &argInCnt, &argInList) != TCL_OK)
  69.             return TCL_ERROR;
  70.  
  71.         if (argInCnt > STATIC_ARG_SIZE - 2)
  72.             argList = (char **) ckalloc ((argInCnt + 1) * sizeof (char **));
  73.             
  74.         for (idx = 0; idx < argInCnt; idx++)
  75.             argList [idx + 1] = argInList [idx];
  76.  
  77.         argList [argInCnt + 1] = NULL;
  78.     } else {
  79.         argList [1] = NULL;
  80.     }
  81.  
  82.     argList [0] = argv [1];  /* Program name */
  83.  
  84.     if (execvp (argv[1], argList) < 0) {
  85.         if (argInList != NULL)
  86.             ckfree (argInList);
  87.         if (argList != staticArgv)
  88.             ckfree (argList);
  89.  
  90.         interp->result = Tcl_PosixError (interp);
  91.         return TCL_ERROR;
  92.     }
  93.  
  94. }
  95.  
  96. /*
  97.  *-----------------------------------------------------------------------------
  98.  *
  99.  * Tcl_ForkCmd --
  100.  *     Implements the TCL fork command:
  101.  *     fork
  102.  *
  103.  * Results:
  104.  *  Standard TCL results, may return the UNIX system error message.
  105.  *
  106.  *-----------------------------------------------------------------------------
  107.  */
  108. int
  109. Tcl_ForkCmd (clientData, interp, argc, argv)
  110.     ClientData  clientData;
  111.     Tcl_Interp *interp;
  112.     int         argc;
  113.     char      **argv;
  114. {
  115.     int pid;
  116.  
  117.     if (argc != 1) {
  118.         Tcl_AppendResult (interp, tclXWrongArgs, argv [0], (char *) NULL);
  119.         return TCL_ERROR;
  120.     }
  121.  
  122.     pid = fork ();
  123.     if (pid < 0) {
  124.         interp->result = Tcl_PosixError (interp);
  125.         return TCL_ERROR;
  126.     }
  127.  
  128.     sprintf(interp->result, "%d", pid);
  129.     return TCL_OK;
  130. }
  131.  
  132. /*
  133.  *-----------------------------------------------------------------------------
  134.  *
  135.  * Tcl_WaitCmd --
  136.  *   Implements the TCL wait command:
  137.  *     wait ?-nohang? ?-untraced? ?-pgroup? ?pid?
  138.  *
  139.  * Results:
  140.  *   Standard TCL results, may return the UNIX system error message.
  141.  *
  142.  *-----------------------------------------------------------------------------
  143.  */
  144. int
  145. Tcl_WaitCmd (clientData, interp, argc, argv)
  146.     ClientData  clientData;
  147.     Tcl_Interp *interp;
  148.     int         argc;
  149.     char      **argv;
  150. {
  151.     WAIT_STATUS_TYPE  status;
  152.     int               idx, tmpPid, options = 0, pgroup = FALSE;
  153.     pid_t             pid, returnedPid;
  154.     
  155.     for (idx = 1; idx < argc; idx++) {
  156.         if (argv [idx][0] != '-')
  157.             break;
  158.         if (STREQU ("-nohang", argv [idx])) {
  159.             if (options & WNOHANG)
  160.                 goto usage;
  161.             options |= WNOHANG;
  162.             continue;
  163.         }
  164.         if (STREQU ("-untraced", argv [idx])) {
  165.             if (options & WUNTRACED)
  166.                 goto usage;
  167.             options |= WUNTRACED;
  168.             continue;
  169.         }
  170.         if (STREQU ("-pgroup", argv [idx])) {
  171.             if (pgroup)
  172.                 goto usage;
  173.             pgroup = TRUE;
  174.             continue;
  175.         }
  176.         goto usage;  /* None match */
  177.     }
  178.     /*
  179.      * Check for more than one non-minus argument.  If ok, convert pid,
  180.      * if supplied.
  181.      */
  182.     if (idx < argc - 1)
  183.         goto usage;  
  184.     if (idx < argc) {
  185.         if (!Tcl_StrToInt (argv [idx], 10, &tmpPid))
  186.             goto invalidPid;
  187.         if (tmpPid <= 0)
  188.             goto negativePid;
  189.         pid = (pid_t) tmpPid;
  190.         if ((int) pid != tmpPid)
  191.             goto invalidPid;
  192.     } else {
  193.         pid = -1;  /* pid or pgroup not supplied */
  194.     }
  195.  
  196.     /*
  197.      * Versions that don't have real waitpid have limited functionality.
  198.      */
  199. #if NO_WAITPID
  200.     if ((options != 0) || pgroup) {
  201.         Tcl_AppendResult (interp, "The \"-nohang\", \"-untraced\" and ",
  202.                           "\"-pgroup\" options are not available on this ",
  203.                           "system", (char *) NULL);
  204.         return TCL_ERROR;
  205.     }
  206. #endif
  207.  
  208.     if (pgroup) {
  209.         if (pid > 0)
  210.             pid = -pid;
  211.         else
  212.             pid = 0;
  213.     }
  214.  
  215.     returnedPid = waitpid (pid, &status, options);
  216.  
  217.     if (returnedPid < 0) {
  218.         interp->result = Tcl_PosixError (interp);
  219.         return TCL_ERROR;
  220.     }
  221.  
  222.     /*
  223.      * If no process was available, return an empty status.  Otherwise return
  224.      * a list contain the PID and why it stopped.
  225.      */
  226.     if (returnedPid == 0)
  227.         return TCL_OK;
  228.     
  229.     if (WIFEXITED (status))
  230.         sprintf (interp->result, "%d %s %d", returnedPid, "EXIT", 
  231.                  WEXITSTATUS (status));
  232.     else if (WIFSIGNALED (status))
  233.         sprintf (interp->result, "%d %s %s", returnedPid, "SIG", 
  234.                  Tcl_SignalId (WTERMSIG (status)));
  235.     else if (WIFSTOPPED (status))
  236.         sprintf (interp->result, "%d %s %s", returnedPid, "STOP", 
  237.                  Tcl_SignalId (WSTOPSIG (status)));
  238.  
  239.     return TCL_OK;
  240.  
  241. usage:
  242.     Tcl_AppendResult (interp, tclXWrongArgs, argv [0], " ", 
  243.                       "?-nohang? ?-untraced? ?-pgroup? ?pid?",
  244.                       (char *) NULL);
  245.     return TCL_ERROR;
  246.  
  247.   invalidPid:
  248.     Tcl_AppendResult (interp, "invalid pid or process group id \"",
  249.                       argv [idx], "\"", (char *) NULL);
  250.     return TCL_ERROR;
  251.  
  252.   negativePid:
  253.     Tcl_AppendResult (interp, "pid or process group id must be greater ",
  254.                       "than zero", (char *) NULL);
  255.     return TCL_ERROR;
  256. }
  257.