1/*
2 * tclXfstat.c
3 *
4 * Extended Tcl fstat command.
5 *-----------------------------------------------------------------------------
6 * Copyright 1991-1999 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: tclXfstat.c,v 1.1 2001/10/24 23:31:48 hobbs Exp $
16 *-----------------------------------------------------------------------------
17 */
18#include "tclExtdInt.h"
19
20#ifndef S_IFMT
21#   define S_IFMT  0170000
22#endif
23
24/*
25 * Table to convert file mode to symbolic file type.  Note, the S_ macros
26 * are not used because the BSD macros don't distinguish between a fifo and
27 * a socket.
28 */
29static struct {
30    int intType;
31    char *strType;
32} modeToSymTable [] = {
33    {S_IFIFO,  "fifo"},
34    {S_IFCHR,  "characterSpecial"},
35    {S_IFDIR,  "directory"},
36#ifdef S_IFBLK
37    {S_IFBLK,  "blockSpecial"},
38#endif
39    {S_IFREG,  "file"},
40#ifdef S_IFLNK
41    {S_IFLNK,  "link"},
42#endif
43#ifdef S_IFSOCK
44    {S_IFSOCK, "socket"},
45#endif
46    {0,        NULL}
47};
48
49/*
50 * Prototypes of internal functions.
51 */
52static char *
53StrFileType _ANSI_ARGS_((struct stat  *statBufPtr));
54
55static void
56ReturnStatList _ANSI_ARGS_((Tcl_Interp   *interp,
57                            int           ttyDev,
58                            struct stat  *statBufPtr));
59
60static int
61ReturnStatArray _ANSI_ARGS_((Tcl_Interp   *interp,
62                             int           ttyDev,
63                             struct stat  *statBufPtr,
64                             Tcl_Obj      *arrayObj));
65
66static int
67ReturnStatItem _ANSI_ARGS_((Tcl_Interp   *interp,
68                            Tcl_Channel   channel,
69                            int           ttyDev,
70                            struct stat  *statBufPtr,
71                            char         *itemName));
72
73static int
74TclX_FstatObjCmd _ANSI_ARGS_((ClientData clientData,
75                              Tcl_Interp *interp,
76                              int objc,
77                              Tcl_Obj *CONST objv[]));
78
79
80/*-----------------------------------------------------------------------------
81 * StrFileType --
82 *
83 *   Looks at stat mode and returns a text string indicating what type of
84 * file it is.
85 *
86 * Parameters:
87 *   o statBufPtr (I) - Pointer to a buffer initialized by stat or fstat.
88 * Returns:
89 *   A pointer static text string representing the type of the file.
90 *-----------------------------------------------------------------------------
91 */
92static char *
93StrFileType (statBufPtr)
94    struct stat  *statBufPtr;
95{
96    int idx;
97
98    for (idx = 0; modeToSymTable [idx].strType != NULL; idx++) {
99        if ((statBufPtr->st_mode & S_IFMT) == modeToSymTable [idx].intType)
100            return modeToSymTable [idx].strType;
101    }
102    return "unknown";
103}
104
105/*-----------------------------------------------------------------------------
106 * ReturnStatList --
107 *
108 *   Return file stat infomation as a keyed list.
109 *
110 * Parameters:
111 *   o interp (I) - The list is returned in result.
112 *   o ttyDev (O) - A boolean indicating if the device is associated with a
113 *     tty.
114 *   o statBufPtr (I) - Pointer to a buffer initialized by stat or fstat.
115 *-----------------------------------------------------------------------------
116 */
117static void
118ReturnStatList (interp,ttyDev, statBufPtr)
119    Tcl_Interp   *interp;
120    int           ttyDev;
121    struct stat  *statBufPtr;
122{
123    Tcl_Obj *keylPtr = TclX_NewKeyedListObj ();
124
125    TclX_KeyedListSet (interp, keylPtr, "atime",
126                       Tcl_NewLongObj ((long) statBufPtr->st_atime));
127    TclX_KeyedListSet (interp, keylPtr, "ctime",
128                       Tcl_NewLongObj ((long) statBufPtr->st_ctime));
129    TclX_KeyedListSet (interp, keylPtr, "dev",
130                       Tcl_NewIntObj ((int) statBufPtr->st_dev));
131    TclX_KeyedListSet (interp, keylPtr, "gid",
132                       Tcl_NewIntObj ((int) statBufPtr->st_gid));
133    TclX_KeyedListSet (interp, keylPtr, "ino",
134                       Tcl_NewIntObj ((int) statBufPtr->st_ino));
135    TclX_KeyedListSet (interp, keylPtr, "mode",
136                       Tcl_NewIntObj ((int) statBufPtr->st_mode));
137    TclX_KeyedListSet (interp, keylPtr, "mtime",
138                       Tcl_NewLongObj ((long) statBufPtr->st_mtime));
139    TclX_KeyedListSet (interp, keylPtr, "nlink",
140                       Tcl_NewIntObj ((int) statBufPtr->st_nlink));
141    TclX_KeyedListSet (interp, keylPtr, "size",
142                       Tcl_NewLongObj ((long) statBufPtr->st_size));
143    TclX_KeyedListSet (interp, keylPtr, "uid",
144                       Tcl_NewIntObj ((int) statBufPtr->st_uid));
145    TclX_KeyedListSet (interp, keylPtr, "tty",
146                       Tcl_NewBooleanObj (ttyDev));
147    TclX_KeyedListSet (interp, keylPtr, "type",
148                       Tcl_NewStringObj (StrFileType (statBufPtr), -1));
149    Tcl_SetObjResult (interp, keylPtr);
150}
151
152/*-----------------------------------------------------------------------------
153 * ReturnStatArray --
154 *
155 *   Return file stat infomation in an array.
156 *
157 * Parameters:
158 *   o interp (I) - Current interpreter, error return in result.
159 *   o ttyDev (O) - A boolean indicating if the device is associated with a
160 *     tty.
161 *   o statBufPtr (I) - Pointer to a buffer initialized by stat or fstat.
162 *   o arrayObj (I) - The the array to return the info in.
163 * Returns:
164 *   TCL_OK or TCL_ERROR.
165 *-----------------------------------------------------------------------------
166 */
167static int
168ReturnStatArray (interp, ttyDev, statBufPtr, arrayObj)
169    Tcl_Interp   *interp;
170    int           ttyDev;
171    struct stat  *statBufPtr;
172    Tcl_Obj      *arrayObj;
173{
174    char *varName = Tcl_GetStringFromObj (arrayObj, NULL);
175
176    if  (Tcl_SetVar2Ex(interp, varName, "dev",
177                       Tcl_NewIntObj((int)statBufPtr->st_dev),
178                       TCL_LEAVE_ERR_MSG) == NULL)
179        goto errorExit;
180
181    if  (Tcl_SetVar2Ex(interp, varName, "ino",
182                       Tcl_NewIntObj((int)statBufPtr->st_ino),
183                       TCL_LEAVE_ERR_MSG) == NULL)
184        goto errorExit;
185
186    if  (Tcl_SetVar2Ex(interp, varName, "mode",
187                       Tcl_NewIntObj((int)statBufPtr->st_mode),
188                       TCL_LEAVE_ERR_MSG) == NULL)
189        goto errorExit;
190
191    if  (Tcl_SetVar2Ex(interp, varName, "nlink",
192                       Tcl_NewIntObj((int)statBufPtr->st_nlink),
193                       TCL_LEAVE_ERR_MSG) == NULL)
194        goto errorExit;
195
196    if  (Tcl_SetVar2Ex(interp, varName, "uid",
197                       Tcl_NewIntObj((int)statBufPtr->st_uid),
198                       TCL_LEAVE_ERR_MSG) == NULL)
199        goto errorExit;
200
201    if  (Tcl_SetVar2Ex(interp, varName, "gid",
202                       Tcl_NewIntObj((int)statBufPtr->st_gid),
203                       TCL_LEAVE_ERR_MSG) == NULL)
204        goto errorExit;
205
206    if  (Tcl_SetVar2Ex(interp, varName, "size",
207                       Tcl_NewLongObj((long)statBufPtr->st_size),
208                       TCL_LEAVE_ERR_MSG) == NULL)
209        goto errorExit;
210
211    if  (Tcl_SetVar2Ex(interp, varName, "atime",
212                       Tcl_NewLongObj((long)statBufPtr->st_atime),
213                       TCL_LEAVE_ERR_MSG) == NULL)
214        goto errorExit;
215
216    if  (Tcl_SetVar2Ex(interp, varName, "mtime",
217                         Tcl_NewLongObj((long)statBufPtr->st_mtime),
218                         TCL_LEAVE_ERR_MSG) == NULL)
219        goto errorExit;
220
221    if  (Tcl_SetVar2Ex(interp, varName, "ctime",
222                       Tcl_NewLongObj((long)statBufPtr->st_ctime),
223                       TCL_LEAVE_ERR_MSG) == NULL)
224        goto errorExit;
225
226    if (Tcl_SetVar2Ex(interp, varName, "tty",
227                      Tcl_NewBooleanObj(ttyDev),
228                      TCL_LEAVE_ERR_MSG) == NULL)
229        goto errorExit;
230
231    if (Tcl_SetVar2Ex(interp, varName, "type",
232                      Tcl_NewStringObj(StrFileType(statBufPtr), -1),
233                      TCL_LEAVE_ERR_MSG) == NULL)
234        goto errorExit;
235
236    return TCL_OK;
237
238  errorExit:
239    return TCL_ERROR;
240}
241
242/*-----------------------------------------------------------------------------
243 * ReturnStatItem --
244 *
245 *   Return a single file status item.
246 *
247 * Parameters:
248 *   o interp (I) - Item or error returned in result.
249 *   o channel (I) - Channel the file is assoicated with.
250 *   o ttyDev (O) - A boolean indicating if the device is associated with a
251 *     tty.
252 *   o statBufPtr (I) - Pointer to a buffer initialized by stat or fstat.
253 *   o itemName (I) - The name of the desired item.
254 * Returns:
255 *   TCL_OK or TCL_ERROR.
256 *-----------------------------------------------------------------------------
257 */
258static int
259ReturnStatItem (interp, channel, ttyDev, statBufPtr, itemName)
260    Tcl_Interp   *interp;
261    Tcl_Channel   channel;
262    int           ttyDev;
263    struct stat  *statBufPtr;
264    char         *itemName;
265{
266    Tcl_Obj *objPtr;
267
268    if (STREQU (itemName, "dev"))
269        objPtr = Tcl_NewIntObj ((int) statBufPtr->st_dev);
270    else if (STREQU (itemName, "ino"))
271        objPtr = Tcl_NewIntObj ((int) statBufPtr->st_ino);
272    else if (STREQU (itemName, "mode"))
273        objPtr = Tcl_NewIntObj ((int) statBufPtr->st_mode);
274    else if (STREQU (itemName, "nlink"))
275        objPtr = Tcl_NewIntObj ((int) statBufPtr->st_nlink);
276    else if (STREQU (itemName, "uid"))
277        objPtr = Tcl_NewIntObj ((int) statBufPtr->st_uid);
278    else if (STREQU (itemName, "gid"))
279        objPtr = Tcl_NewIntObj ((int) statBufPtr->st_gid);
280    else if (STREQU (itemName, "size"))
281        objPtr = Tcl_NewLongObj ((long) statBufPtr->st_size);
282    else if (STREQU (itemName, "atime"))
283        objPtr = Tcl_NewLongObj ((long) statBufPtr->st_atime);
284    else if (STREQU (itemName, "mtime"))
285        objPtr = Tcl_NewLongObj ((long) statBufPtr->st_mtime);
286    else if (STREQU (itemName, "ctime"))
287        objPtr = Tcl_NewLongObj ((long) statBufPtr->st_ctime);
288    else if (STREQU (itemName, "type"))
289        objPtr = Tcl_NewStringObj (StrFileType (statBufPtr), -1);
290    else if (STREQU (itemName, "tty"))
291        objPtr = Tcl_NewBooleanObj (ttyDev);
292    else if (STREQU (itemName, "remotehost")) {
293        objPtr = TclXGetHostInfo (interp, channel, TRUE);
294        if (objPtr == NULL)
295            return TCL_ERROR;
296    } else if (STREQU (itemName, "localhost")) {
297        objPtr = TclXGetHostInfo (interp, channel, FALSE);
298        if (objPtr == NULL)
299            return TCL_ERROR;
300    } else {
301        TclX_AppendObjResult (interp, "Got \"", itemName,
302                              "\", expected one of ",
303                              "\"atime\", \"ctime\", \"dev\", \"gid\", ",
304                              "\"ino\", \"mode\", \"mtime\", \"nlink\", ",
305                              "\"size\", \"tty\", \"type\", \"uid\", ",
306                              "\"remotehost\", or \"localhost\"",
307                              (char *) NULL);
308        return TCL_ERROR;
309    }
310
311    Tcl_SetObjResult (interp, objPtr);
312    return TCL_OK;
313}
314
315/*-----------------------------------------------------------------------------
316 * TclX_FstatObjCmd --
317 *      Implements the fstat TCL command:
318 *         fstat fileId ?item?|?stat arrayvar?
319 *-----------------------------------------------------------------------------
320 */
321static int
322TclX_FstatObjCmd (clientData, interp, objc, objv)
323    ClientData  clientData;
324    Tcl_Interp *interp;
325    int         objc;
326    Tcl_Obj    *CONST objv[];
327{
328    Tcl_Channel channel;
329    struct stat statBuf;
330    int ttyDev;
331
332    if ((objc < 2) || (objc > 4)) {
333        return TclX_WrongArgs (interp, objv [0],
334                               "fileId ?item?|?stat arrayVar?");
335    }
336
337    channel = TclX_GetOpenChannelObj (interp, objv [1], 0);
338    if (channel == NULL)
339        return TCL_ERROR;
340
341    if (TclXOSFstat (interp, channel, &statBuf, &ttyDev)) {
342        return TCL_ERROR;
343    }
344
345    /*
346     * Return data in the requested format.
347     */
348    if (objc >= 3) {
349        char *itemName = Tcl_GetStringFromObj (objv [2], NULL);
350
351        if (objc == 4) {
352            if (!STREQU (itemName, "stat")) {
353                TclX_AppendObjResult (interp,
354                                      "expected item name of \"stat\" when ",
355                                      "using array name", (char *) NULL);
356                return TCL_ERROR;
357            }
358            return ReturnStatArray (interp, ttyDev, &statBuf, objv [3]);
359        } else {
360            return ReturnStatItem (interp, channel, ttyDev, &statBuf,
361                                   itemName);
362        }
363    }
364    ReturnStatList (interp, ttyDev, &statBuf);
365    return TCL_OK;
366}
367
368
369/*-----------------------------------------------------------------------------
370 * TclX_FstatInit --
371 *     Initialize the fstat command.
372 *-----------------------------------------------------------------------------
373 */
374void
375TclX_FstatInit (interp)
376    Tcl_Interp *interp;
377{
378    Tcl_CreateObjCommand (interp,
379                          "fstat",
380                          TclX_FstatObjCmd,
381                          (ClientData) NULL,
382                          (Tcl_CmdDeleteProc*) NULL);
383}
384