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 / tclXfstat.c < prev    next >
Encoding:
C/C++ Source or Header  |  1993-10-26  |  12.8 KB  |  410 lines  |  [TEXT/MPS ]
  1. #ifdef MPW
  2. #    pragma segment TCLExtend
  3. #endif
  4. /*
  5.  * tclXfstat.c
  6.  *
  7.  * Extended Tcl fstat command.
  8.  *-----------------------------------------------------------------------------
  9.  * Copyright 1991-1993 Karl Lehenbauer and Mark Diekhans.
  10.  *
  11.  * Permission to use, copy, modify, and distribute this software and its
  12.  * documentation for any purpose and without fee is hereby granted, provided
  13.  * that the above copyright notice appear in all copies.  Karl Lehenbauer and
  14.  * Mark Diekhans make no representations about the suitability of this
  15.  * software for any purpose.  It is provided "as is" without express or
  16.  * implied warranty.
  17.  *-----------------------------------------------------------------------------
  18.  * $Id: tclXfstat.c,v 1.4 1993/07/30 15:05:15 markd Exp $
  19.  *-----------------------------------------------------------------------------
  20.  */
  21. #include "tclExtdInt.h"
  22.  
  23. #ifndef macintosh
  24. #ifndef NO_SYS_SOCKET_H
  25.  
  26. #include <sys/types.h>
  27. #include <sys/socket.h>
  28. #include <netdb.h>
  29. #include <netinet/in.h>
  30. #include <arpa/inet.h>
  31. #endif
  32. #endif
  33.  
  34. /*
  35.  * Prototypes of internal functions.
  36.  */
  37. static int
  38. GetRemoteHost _ANSI_ARGS_((Tcl_Interp *interp,
  39.                            FILE       *filePtr));
  40.  
  41. static char *
  42. GetFileType _ANSI_ARGS_((struct stat  *statBufPtr));
  43.  
  44. static void
  45. ReturnStatList _ANSI_ARGS_((Tcl_Interp   *interp,
  46.                             FILE         *filePtr,
  47.                             struct stat  *statBufPtr));
  48.  
  49. static int
  50. ReturnStatArray _ANSI_ARGS_((Tcl_Interp   *interp,
  51.                              FILE         *filePtr,
  52.                              struct stat  *statBufPtr,
  53.                              char         *arrayName));
  54.  
  55. static int
  56. ReturnStatItem _ANSI_ARGS_((Tcl_Interp   *interp,
  57.                             FILE         *filePtr,
  58.                             struct stat  *statBufPtr,
  59.                             char         *itemName));
  60.  
  61. #ifndef NO_SYS_SOCKET_H
  62.  
  63. /*
  64.  *-----------------------------------------------------------------------------
  65.  *
  66.  * GetRemoteHost --
  67.  *     Return the remote host IP address and name (if it can be obtained)
  68.  * as a list.
  69.  *
  70.  * Parameters:
  71.  *   o interp (O) - List is returned in the result.
  72.  *   o filePtr (I) - Pointer to file.  Should be a socket connection.
  73.  * Returns:
  74.  *   TCL_OK or TCL_ERROR.
  75.  *-----------------------------------------------------------------------------
  76.  */
  77. static int
  78. GetRemoteHost (interp, filePtr)
  79.     Tcl_Interp *interp;
  80.     FILE       *filePtr;
  81. {
  82.     int                 socketFD, nameLen;
  83.     struct sockaddr_in  remote;
  84.     struct hostent     *hostEntry;
  85.  
  86.     socketFD = fileno (filePtr);
  87.     nameLen = sizeof (remote);
  88.  
  89.     if (getpeername (socketFD, &remote, &nameLen) < 0)
  90.         goto unixError;
  91.     Tcl_AppendElement (interp, inet_ntoa (remote.sin_addr));
  92.  
  93.     hostEntry = gethostbyaddr ((char *) &(remote.sin_addr.s_addr),
  94.                                sizeof (remote.sin_addr.s_addr),
  95.                                AF_INET);
  96.     if (hostEntry != NULL)
  97.         Tcl_AppendElement (interp, hostEntry->h_name);
  98.        
  99.     return TCL_OK;
  100.  
  101.   unixError:
  102.     Tcl_ResetResult (interp);
  103.     interp->result = Tcl_PosixError (interp);
  104.     return TCL_ERROR;
  105. }
  106. #else
  107.  
  108. /*
  109.  *-----------------------------------------------------------------------------
  110.  *
  111.  * GetRemoteHost --
  112.  *     Version of this functions that always returns an error on systems that
  113.  * don't have sockets.
  114.  *-----------------------------------------------------------------------------
  115.  */
  116. static int
  117. GetRemoteHost (interp, filePtr)
  118.     Tcl_Interp *interp;
  119.     FILE       *filePtr;
  120. {
  121.     interp->result = "sockets are not available on this system";
  122.     return TCL_ERROR;
  123. }
  124. #endif /* NO_SYS_SOCKET_H */
  125.  
  126. /*
  127.  *-----------------------------------------------------------------------------
  128.  *
  129.  * GetFileType --
  130.  *
  131.  *   Looks at stat mode and returns a text string indicating what type of
  132.  * file it is.
  133.  *
  134.  * Parameters:
  135.  *   o statBufPtr (I) - Pointer to a buffer initialized by stat or fstat.
  136.  * Returns:
  137.  *   A pointer static text string representing the type of the file.
  138.  *-----------------------------------------------------------------------------
  139.  */
  140. static char *
  141. GetFileType (statBufPtr)
  142.     struct stat  *statBufPtr;
  143. {
  144.     char *typeStr;
  145.  
  146.     /*
  147.      * Get a string representing the type of the file.
  148.      */
  149.     if (S_ISREG (statBufPtr->st_mode)) {
  150.         typeStr = "file";
  151.     } else if (S_ISDIR (statBufPtr->st_mode)) {
  152.         typeStr = "directory";
  153.     } else if (S_ISCHR (statBufPtr->st_mode)) {
  154.         typeStr = "characterSpecial";
  155.     } else if (S_ISBLK (statBufPtr->st_mode)) {
  156.         typeStr = "blockSpecial";
  157.     } else if (S_ISFIFO (statBufPtr->st_mode)) {
  158.         typeStr = "fifo";
  159.     } else if (S_ISLNK (statBufPtr->st_mode)) {
  160.         typeStr = "link";
  161.     } else if (S_ISSOCK (statBufPtr->st_mode)) {
  162.         typeStr = "socket";
  163.     } else {
  164.         typeStr = "unknown";
  165.     }
  166.  
  167.     return typeStr;
  168. }
  169.  
  170. /*
  171.  *-----------------------------------------------------------------------------
  172.  *
  173.  * ReturnStatList --
  174.  *
  175.  *   Return file stat infomation as a keyed list.
  176.  *
  177.  * Parameters:
  178.  *   o interp (I) - The list is returned in result.
  179.  *   o filePtr (I) - Pointer to the Tcl open file structure.
  180.  *   o statBufPtr (I) - Pointer to a buffer initialized by stat or fstat.
  181.  *-----------------------------------------------------------------------------
  182.  */
  183. static void
  184. ReturnStatList (interp, filePtr, statBufPtr)
  185.     Tcl_Interp   *interp;
  186.     FILE         *filePtr;
  187.     struct stat  *statBufPtr;
  188. {
  189.     char statList [200];
  190.  
  191.     sprintf (statList, 
  192.              "{atime %d} {ctime %d} {dev %d} {gid %d} {ino %d} {mode %d} ",
  193.               statBufPtr->st_atime, statBufPtr->st_ctime, statBufPtr->st_dev,
  194.               statBufPtr->st_gid,   statBufPtr->st_ino,   statBufPtr->st_mode);
  195.     Tcl_AppendResult (interp, statList, (char *) NULL);
  196.  
  197.     sprintf (statList, 
  198.              "{mtime %d} {nlink %d} {size %d} {uid %d} {tty %d} {type %s}",
  199.              statBufPtr->st_mtime,  statBufPtr->st_nlink, statBufPtr->st_size,
  200.              statBufPtr->st_uid,    isatty (fileno (filePtr)),
  201.              GetFileType (statBufPtr));
  202.     Tcl_AppendResult (interp, statList, (char *) NULL);
  203.  
  204. }
  205.  
  206. /*
  207.  *-----------------------------------------------------------------------------
  208.  *
  209.  * ReturnStatArray --
  210.  *
  211.  *   Return file stat infomation in an array.
  212.  *
  213.  * Parameters:
  214.  *   o interp (I) - Current interpreter, error return in result.
  215.  *   o filePtr (I) - Pointer to the Tcl open file structure.
  216.  *   o statBufPtr (I) - Pointer to a buffer initialized by stat or fstat.
  217.  *   o arrayName (I) - The name of the array to return the info in.
  218.  * Returns:
  219.  *   TCL_OK or TCL_ERROR.
  220.  *-----------------------------------------------------------------------------
  221.  */
  222. static int
  223. ReturnStatArray (interp, filePtr, statBufPtr, arrayName)
  224.     Tcl_Interp   *interp;
  225.     FILE         *filePtr;
  226.     struct stat  *statBufPtr;
  227.     char         *arrayName;
  228. {
  229.     char numBuf [30];
  230.  
  231.     sprintf (numBuf, "%d", statBufPtr->st_dev);
  232.     if  (Tcl_SetVar2 (interp, arrayName, "dev", numBuf, 
  233.                       TCL_LEAVE_ERR_MSG) == NULL)
  234.         return TCL_ERROR;
  235.  
  236.     sprintf (numBuf, "%d", statBufPtr->st_ino);
  237.     if  (Tcl_SetVar2 (interp, arrayName, "ino", numBuf,
  238.                          TCL_LEAVE_ERR_MSG) == NULL)
  239.         return TCL_ERROR;
  240.  
  241.     sprintf (numBuf, "%d", statBufPtr->st_mode);
  242.     if  (Tcl_SetVar2 (interp, arrayName, "mode", numBuf, 
  243.                       TCL_LEAVE_ERR_MSG) == NULL)
  244.         return TCL_ERROR;
  245.  
  246.     sprintf (numBuf, "%d", statBufPtr->st_nlink);
  247.     if  (Tcl_SetVar2 (interp, arrayName, "nlink", numBuf,
  248.                       TCL_LEAVE_ERR_MSG) == NULL)
  249.         return TCL_ERROR;
  250.  
  251.     sprintf (numBuf, "%d", statBufPtr->st_uid);
  252.     if  (Tcl_SetVar2 (interp, arrayName, "uid", numBuf,
  253.                       TCL_LEAVE_ERR_MSG) == NULL)
  254.         return TCL_ERROR;
  255.  
  256.     sprintf (numBuf, "%d", statBufPtr->st_gid);
  257.     if  (Tcl_SetVar2 (interp, arrayName, "gid", numBuf,
  258.                       TCL_LEAVE_ERR_MSG) == NULL)
  259.         return TCL_ERROR;
  260.  
  261.     sprintf (numBuf, "%d", statBufPtr->st_size);
  262.     if  (Tcl_SetVar2 (interp, arrayName, "size", numBuf,
  263.                       TCL_LEAVE_ERR_MSG) == NULL)
  264.         return TCL_ERROR;
  265.  
  266.     sprintf (numBuf, "%d", statBufPtr->st_atime);
  267.     if  (Tcl_SetVar2 (interp, arrayName, "atime", numBuf,
  268.                       TCL_LEAVE_ERR_MSG) == NULL)
  269.         return TCL_ERROR;
  270.  
  271.     sprintf (numBuf, "%d", statBufPtr->st_mtime);
  272.     if  (Tcl_SetVar2 (interp, arrayName, "mtime", numBuf,
  273.                       TCL_LEAVE_ERR_MSG) == NULL)
  274.         return TCL_ERROR;
  275.  
  276.     sprintf (numBuf, "%d", statBufPtr->st_ctime);
  277.     if  (Tcl_SetVar2 (interp, arrayName, "ctime", numBuf,
  278.                       TCL_LEAVE_ERR_MSG) == NULL)
  279.         return TCL_ERROR;
  280.  
  281.     if (Tcl_SetVar2 (interp, arrayName, "tty", 
  282.                      isatty (fileno (filePtr)) ? "1" : "0",
  283.                      TCL_LEAVE_ERR_MSG) == NULL)
  284.         return TCL_ERROR;
  285.  
  286.     if (Tcl_SetVar2 (interp, arrayName, "type", GetFileType (statBufPtr),
  287.                      TCL_LEAVE_ERR_MSG) == NULL)
  288.         return TCL_ERROR;
  289.  
  290.     return TCL_OK;
  291.  
  292. }
  293.  
  294. /*
  295.  *-----------------------------------------------------------------------------
  296.  *
  297.  * ReturnStatItem --
  298.  *
  299.  *   Return a single file status item.
  300.  *
  301.  * Parameters:
  302.  *   o interp (I) - Item or error returned in result.
  303.  *   o filePtr (I) - Pointer to the Tcl open file structure.
  304.  *   o statBufPtr (I) - Pointer to a buffer initialized by stat or fstat.
  305.  *   o itemName (I) - The name of the desired item.
  306.  * Returns:
  307.  *   TCL_OK or TCL_ERROR.
  308.  *-----------------------------------------------------------------------------
  309.  */
  310. static int
  311. ReturnStatItem (interp, filePtr, statBufPtr, itemName)
  312.     Tcl_Interp   *interp;
  313.     FILE         *filePtr;
  314.     struct stat  *statBufPtr;
  315.     char         *itemName;
  316. {
  317.     if (STREQU (itemName, "dev"))
  318.         sprintf (interp->result, "%d", statBufPtr->st_dev);
  319.     else if (STREQU (itemName, "ino"))
  320.         sprintf (interp->result, "%d", statBufPtr->st_ino);
  321.     else if (STREQU (itemName, "mode"))
  322.         sprintf (interp->result, "%d", statBufPtr->st_mode);
  323.     else if (STREQU (itemName, "nlink"))
  324.         sprintf (interp->result, "%d", statBufPtr->st_nlink);
  325.     else if (STREQU (itemName, "uid"))
  326.         sprintf (interp->result, "%d", statBufPtr->st_uid);
  327.     else if (STREQU (itemName, "gid"))
  328.         sprintf (interp->result, "%d", statBufPtr->st_gid);
  329.     else if (STREQU (itemName, "size"))
  330.         sprintf (interp->result, "%d", statBufPtr->st_size);
  331.     else if (STREQU (itemName, "atime"))
  332.         sprintf (interp->result, "%d", statBufPtr->st_atime);
  333.     else if (STREQU (itemName, "mtime"))
  334.         sprintf (interp->result, "%d", statBufPtr->st_mtime);
  335.     else if (STREQU (itemName, "ctime"))
  336.         sprintf (interp->result, "%d", statBufPtr->st_ctime);
  337.     else if (STREQU (itemName, "type"))
  338.         interp->result = GetFileType (statBufPtr);
  339.     else if (STREQU (itemName, "tty"))
  340.         interp->result = isatty (fileno (filePtr)) ? "1" : "0";
  341.     else if (STREQU (itemName, "remotehost")) {
  342.         if (GetRemoteHost (interp, filePtr) != TCL_OK)
  343.             return TCL_ERROR;
  344.     } else {
  345.         Tcl_AppendResult (interp, "Got \"", itemName, "\", expected one of ",
  346.                           "\"atime\", \"ctime\", \"dev\", \"gid\", \"ino\", ",
  347.                           "\"mode\", \"mtime\", \"nlink\", \"size\", ",
  348.                           "\"tty\", \"type\", \"uid\", or \"remotehost\"",
  349.                           (char *) NULL);
  350.         return TCL_ERROR;
  351.     }
  352.  
  353.     return TCL_OK;
  354.  
  355. }
  356.  
  357. /*
  358.  *-----------------------------------------------------------------------------
  359.  *
  360.  * Tcl_FstatCmd --
  361.  *     Implements the fstat TCL command:
  362.  *         fstat fileId ?item?|?stat arrayvar?
  363.  *
  364.  *-----------------------------------------------------------------------------
  365.  */
  366. int
  367. Tcl_FstatCmd (clientData, interp, argc, argv)
  368.     ClientData  clientData;
  369.     Tcl_Interp *interp;
  370.     int         argc;
  371.     char      **argv;
  372. {
  373.     FILE         *filePtr;
  374.     struct stat  statBuf;
  375.  
  376.     if ((argc < 2) || (argc > 4)) {
  377.         Tcl_AppendResult (interp, tclXWrongArgs, argv [0], 
  378.                           " fileId ?item?|?stat arrayVar?", (char *) NULL);
  379.         return TCL_ERROR;
  380.     }
  381.  
  382.     if (Tcl_GetOpenFile (interp, argv[1],
  383.                          FALSE, FALSE,  /* No checking */
  384.                          &filePtr) != TCL_OK)
  385.     return TCL_ERROR;
  386.     
  387.     if (fstat (fileno (filePtr), &statBuf)) {
  388.         interp->result = Tcl_PosixError (interp);
  389.         return TCL_ERROR;
  390.     }
  391.  
  392.     /*
  393.      * Return data in the requested format.
  394.      */
  395.     if (argc == 4) {
  396.         if (!STREQU (argv [2], "stat")) {
  397.             Tcl_AppendResult (interp, "expected item name of \"stat\" when ",
  398.                               "using array name", (char *) NULL);
  399.             return TCL_ERROR;
  400.         }
  401.         return ReturnStatArray (interp, filePtr, &statBuf, argv [3]);
  402.     }
  403.     if (argc == 3)
  404.         return ReturnStatItem (interp, filePtr, &statBuf, argv [2]);
  405.  
  406.     ReturnStatList (interp, filePtr, &statBuf);
  407.     return TCL_OK;
  408.  
  409. }
  410.