1/*
2 * tclXchmod.c --
3 *
4 *  Chmod, chown and chgrp Tcl commands.
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: tclXchmod.c,v 1.1 2001/10/24 23:31:48 hobbs Exp $
16 *-----------------------------------------------------------------------------
17 */
18
19#include "tclExtdInt.h"
20
21/*
22 * Type used for returning parsed mode informtion.
23 */
24typedef struct {
25    char  *symMode;  /* Symbolic mode. If NULL, use absolute mode. */
26    int    absMode;  /* Numeric mode. */
27} modeInfo_t;
28
29static char *FILE_ID_OPT = "-fileid";
30
31/*
32 * Prototypes of internal functions.
33 */
34static int
35ConvSymMode _ANSI_ARGS_((Tcl_Interp  *interp,
36                         char        *symMode,
37                         int          modeVal));
38static int
39TclX_ChmodObjCmd _ANSI_ARGS_((ClientData clientData,
40                              Tcl_Interp *interp,
41                              int objc,
42                              Tcl_Obj *CONST objv[]));
43
44static int
45TclX_ChownObjCmd _ANSI_ARGS_((ClientData clientData,
46                              Tcl_Interp *interp,
47                              int objc,
48                              Tcl_Obj *CONST objv[]));
49
50static int
51TclX_ChgrpObjCmd _ANSI_ARGS_((ClientData clientData,
52                              Tcl_Interp *interp,
53                              int objc,
54                              Tcl_Obj *CONST objv[]));
55
56
57/*-----------------------------------------------------------------------------
58 * ConvSymMode --
59 *   Parse and convert symbolic file permissions as specified by chmod(C).
60 *
61 * Parameters:
62 *   o interp - Pointer to the current interpreter, error messages will be
63 *     returned in the result.
64 *   o symMode - The symbolic permissions to parse.
65 *   o modeVal - The existing permissions value on a file.
66 *
67 * Returns:
68 *   The new permissions, or -1 if invalid permissions where supplied.
69 *-----------------------------------------------------------------------------
70 */
71static int
72ConvSymMode (interp, symMode, modeVal)
73    Tcl_Interp  *interp;
74    char        *symMode;
75    int          modeVal;
76{
77    int  user, group, other;
78    char operator, *scanPtr;
79    int  rwxMask, ugoMask, setUID, sticky, locking;
80    int  newMode;
81
82    scanPtr = symMode;
83
84    while (*scanPtr != '\0') {
85        user = group = other = FALSE;
86
87        /*
88         * Scan who field.
89         */
90        while (! ((*scanPtr == '+') ||
91                  (*scanPtr == '-') ||
92                  (*scanPtr == '='))) {
93            switch (*scanPtr) {
94                case 'a':
95                    user = group = other = TRUE;
96                    break;
97                case 'u':
98                    user = TRUE;
99                    break;
100                case 'g':
101                    group = TRUE;
102                    break;
103                case 'o':
104                    other = TRUE;
105                    break;
106                default:
107                    goto invalidMode;
108            }
109            scanPtr++;
110        }
111
112        /*
113         * If none where specified, that means all.
114         */
115
116        if (! (user || group || other))
117            user = group = other = TRUE;
118
119        operator = *scanPtr++;
120
121        /*
122         * Decode the permissions
123         */
124
125        rwxMask = 0;
126        setUID = sticky = locking = FALSE;
127
128        /*
129         * Scan permissions field
130         */
131        while (! ((*scanPtr == ',') || (*scanPtr == 0))) {
132            switch (*scanPtr) {
133                case 'r':
134                    rwxMask |= 4;
135                    break;
136                case 'w':
137                    rwxMask |= 2;
138                    break;
139                case 'x':
140                    rwxMask |= 1;
141                    break;
142                case 's':
143                    setUID = TRUE;
144                    break;
145                case 't':
146                    sticky = TRUE;
147                    break;
148                case 'l':
149                    locking = TRUE;
150                    break;
151                default:
152                    goto invalidMode;
153            }
154            scanPtr++;
155        }
156
157        /*
158         * Build mode map of specified values.
159         */
160
161        newMode = 0;
162        ugoMask = 0;
163        if (user) {
164            newMode |= rwxMask << 6;
165            ugoMask |= 0700;
166        }
167        if (group) {
168            newMode |= rwxMask << 3;
169            ugoMask |= 0070;
170        }
171        if (other) {
172            newMode |= rwxMask;
173            ugoMask |= 0007;
174        }
175        if (setUID && user)
176            newMode |= 04000;
177        if ((setUID || locking) && group)
178            newMode |= 02000;
179        if (sticky)
180            newMode |= 01000;
181
182        /*
183         * Add to cumulative mode based on operator.
184         */
185
186        if (operator == '+')
187            modeVal |= newMode;
188        else if (operator == '-')
189            modeVal &= ~newMode;
190        else if (operator == '=')
191            modeVal |= (modeVal & ugoMask) | newMode;
192        if (*scanPtr == ',')
193            scanPtr++;
194    }
195
196    return modeVal;
197
198  invalidMode:
199    TclX_AppendObjResult (interp, "invalid file mode \"", symMode, "\"",
200                          (char *) NULL);
201    return -1;
202}
203
204/*-----------------------------------------------------------------------------
205 * ChmodFileNameObj --
206 *   Change the mode of a file by name.
207 *
208 * Parameters:
209 *   o interp - Pointer to the current interpreter, error messages will be
210 *     returned in the result.
211 *   o modeInfo - Infomation with the mode to set the file to.
212 *   o fileName - Name of the file to change.
213 * Returns:
214 *   TCL_OK or TCL_ERROR.
215 *-----------------------------------------------------------------------------
216 */
217static int
218ChmodFileNameObj (interp, modeInfo, fileNameObj)
219    Tcl_Interp  *interp;
220    modeInfo_t   modeInfo;
221    Tcl_Obj     *fileNameObj;
222{
223    char         *filePath;
224    struct stat   fileStat;
225    Tcl_DString   pathBuf;
226    int           newMode;
227    char         *fileName;
228
229    Tcl_DStringInit (&pathBuf);
230
231    fileName = Tcl_GetStringFromObj (fileNameObj, NULL);
232    filePath = Tcl_TranslateFileName (interp, fileName, &pathBuf);
233    if (filePath == NULL) {
234        Tcl_DStringFree (&pathBuf);
235        return TCL_ERROR;
236    }
237
238    if (modeInfo.symMode != NULL) {
239        if (stat (filePath, &fileStat) != 0)
240            goto fileError;
241        newMode = ConvSymMode (interp, modeInfo.symMode,
242                               fileStat.st_mode & 07777);
243        if (newMode < 0)
244            goto errorExit;
245    } else {
246        newMode = modeInfo.absMode;
247    }
248    if (TclXOSchmod (interp, filePath, (unsigned short) newMode) < 0)
249        return TCL_ERROR;
250
251    Tcl_DStringFree (&pathBuf);
252    return TCL_OK;
253
254  fileError:
255    TclX_AppendObjResult (interp, filePath, ": ",
256                          Tcl_PosixError (interp), (char *) NULL);
257  errorExit:
258    Tcl_DStringFree (&pathBuf);
259    return TCL_ERROR;
260}
261
262/*-----------------------------------------------------------------------------
263 * ChmodFileIdObj --
264 *   Change the mode of a file by file id.
265 *
266 * Parameters:
267 *   o interp - Pointer to the current interpreter, error messages will be
268 *     returned in the result.
269 *   o modeInfo - Infomation with the mode to set the file to.
270 *   o fileId - The Tcl file id.
271 * Returns:
272 *   TCL_OK or TCL_ERROR.
273 *-----------------------------------------------------------------------------
274 */
275static int
276ChmodFileIdObj (interp, modeInfo, fileIdObj)
277    Tcl_Interp  *interp;
278    modeInfo_t   modeInfo;
279    Tcl_Obj     *fileIdObj;
280{
281    Tcl_Channel channel;
282    struct stat fileStat;
283    int         newMode;
284
285    channel = TclX_GetOpenChannelObj (interp, fileIdObj, 0);
286    if (channel == NULL) {
287        return TCL_ERROR;
288    }
289
290    if (modeInfo.symMode != NULL) {
291        if (TclXOSFstat (interp, channel, &fileStat, NULL) != 0)
292            return TCL_ERROR;
293        newMode = ConvSymMode (interp, modeInfo.symMode,
294                               fileStat.st_mode & 07777);
295        if (newMode < 0)
296            return TCL_ERROR;
297    } else {
298        newMode = modeInfo.absMode;
299    }
300    if (TclXOSfchmod (interp, channel, (unsigned short) newMode,
301                      FILE_ID_OPT) == TCL_ERROR)
302        return TCL_ERROR;
303
304    return TCL_OK;
305}
306
307/*-----------------------------------------------------------------------------
308 * Tcl_ChmodObjCmd --
309 *     Implements the TCL chmod command:
310 *     chmod [fileid] mode filelist
311 *
312 * Results:
313 *  Standard TCL results, may return the UNIX system error message.
314 *
315 *-----------------------------------------------------------------------------
316 */
317static int
318TclX_ChmodObjCmd (clientData, interp, objc, objv)
319    ClientData   clientData;
320    Tcl_Interp  *interp;
321    int          objc;
322    Tcl_Obj    *CONST objv[];
323{
324    int           objIdx, idx, fileObjc, fileIds, result;
325    modeInfo_t    modeInfo;
326    Tcl_Obj     **fileObjv;
327    char         *fileIdsString;
328    char         *modeString;
329    int          modeBits;
330
331    /*
332     * Options are not parsable just looking for "-", since modes can
333     * start with "-".
334     */
335    fileIds = FALSE;
336    objIdx = 1;
337    if (objc > 1) {
338	fileIdsString = Tcl_GetStringFromObj (objv [objIdx], NULL);
339        if (STREQU (fileIdsString, FILE_ID_OPT)) {
340	    fileIds = TRUE;
341	    objIdx++;
342	}
343    }
344
345    if (objIdx != objc - 2)
346	return TclX_WrongArgs (interp, objv [0], "[-fileid] mode filelist");
347
348    modeString = Tcl_GetStringFromObj (objv [objIdx], NULL);
349    if (ISDIGIT (modeString[0])) {
350        if (Tcl_GetIntFromObj (interp, objv [objIdx], &modeBits)
351	  != TCL_OK)
352            return TCL_ERROR;
353	modeInfo.absMode = modeBits;
354        modeInfo.symMode = NULL;
355    } else {
356        modeInfo.symMode = modeString;
357    }
358
359    if (Tcl_ListObjGetElements (interp, objv [objIdx + 1], &fileObjc,
360                       &fileObjv) != TCL_OK)
361        return TCL_ERROR;
362
363    result = TCL_OK;
364    for (idx = 0; (idx < fileObjc) && (result == TCL_OK); idx++) {
365        if (fileIds) {
366            result = ChmodFileIdObj (interp, modeInfo, fileObjv [idx]);
367        } else {
368            result = ChmodFileNameObj (interp, modeInfo, fileObjv [idx]);
369        }
370    }
371
372    return result;
373}
374
375/*-----------------------------------------------------------------------------
376 * Tcl_ChownObjCmd --
377 *     Implements the TCL chown command:
378 *     chown [-fileid] userGrpSpec filelist
379 *
380 * The valid formats of userGrpSpec are:
381 *   {owner}. {owner group} or {owner {}}
382 * Results:
383 *  Standard TCL results, may return the UNIX system error message.
384 *-----------------------------------------------------------------------------
385 */
386static int
387TclX_ChownObjCmd (clientData, interp, objc, objv)
388    ClientData   clientData;
389    Tcl_Interp  *interp;
390    int          objc;
391    Tcl_Obj      *CONST *objv;
392{
393    int        objIdx, ownerObjc, fileIds;
394    Tcl_Obj  **ownerObjv = NULL;
395    unsigned   options;
396    char      *fileIdsSwitch;
397    char      *owner, *group;
398    int        groupStrLen;
399
400
401    /*
402     * Parse options.
403     */
404    fileIds = FALSE;
405    for (objIdx = 1; objIdx < objc ; objIdx++) {
406	fileIdsSwitch = Tcl_GetStringFromObj (objv[objIdx], NULL);
407        if (fileIdsSwitch[0] != '-')
408            break;
409        if (STREQU (fileIdsSwitch, FILE_ID_OPT)) {
410            fileIds = TRUE;
411        } else {
412            TclX_AppendObjResult (interp, "Invalid option \"", fileIdsSwitch,
413                                  "\", expected \"", FILE_ID_OPT, "\"",
414                                  (char *) NULL);
415            return TCL_ERROR;
416        }
417    }
418
419    if (objIdx != objc - 2)
420	return TclX_WrongArgs (interp, objv[0],
421                          "[-fileid] user|{user group} filelist");
422    /*
423     * Parse the owner/group parameter.
424     */
425    if (Tcl_ListObjGetElements (interp, objv [objIdx], &ownerObjc,
426				&ownerObjv) != TCL_OK)
427        return TCL_ERROR;
428
429    if ((ownerObjc < 1) || (ownerObjc > 2)) {
430        TclX_AppendObjResult (interp,
431                              "owner arg should be: user or {user group}",
432                              (char *) NULL);
433        goto errorExit;
434    }
435    options = TCLX_CHOWN;
436    owner = Tcl_GetStringFromObj (ownerObjv [0], NULL);
437    group = NULL;
438    if (ownerObjc == 2) {
439        options |= TCLX_CHGRP;
440	group = Tcl_GetStringFromObj (ownerObjv [1], &groupStrLen);
441        if (groupStrLen == 0)
442            group = NULL;
443    }
444
445    /*
446     * Finally, change ownership.
447     */
448    if (fileIds) {
449        if (TclXOSFChangeOwnGrpObj (interp, options, owner, group,
450				objv [objIdx + 1], "chown -fileid") != TCL_OK)
451            goto errorExit;
452    } else {
453        if (TclXOSChangeOwnGrpObj (interp, options, owner, group,
454			       objv [objIdx + 1], "chown") != TCL_OK)
455            goto errorExit;
456    }
457
458    return TCL_OK;
459
460  errorExit:
461    return TCL_ERROR;
462}
463
464/*-----------------------------------------------------------------------------
465 * Tcl_ChgrpObjCmd --
466 *     Implements the TCL chgrp command:
467 *     chgrp [-fileid] group filelist
468 *
469 * Results:
470 *  Standard TCL results, may return the UNIX system error message.
471 *
472 *-----------------------------------------------------------------------------
473 */
474static int
475TclX_ChgrpObjCmd (clientData, interp, objc, objv)
476    ClientData   clientData;
477    Tcl_Interp  *interp;
478    int          objc;
479    Tcl_Obj     *CONST objv[];
480{
481    int        objIdx, fileIds;
482    char      *fileIdsSwitch, *groupString;
483
484    fileIds = FALSE;
485    for (objIdx = 1; objIdx < objc; objIdx++) {
486	fileIdsSwitch = Tcl_GetStringFromObj (objv [objIdx], NULL);
487        if (fileIdsSwitch[0] != '-')
488            break;
489        if (STREQU (fileIdsSwitch, FILE_ID_OPT)) {
490            fileIds = TRUE;
491        } else {
492            TclX_AppendObjResult (interp, "Invalid option \"", fileIdsSwitch,
493                                  "\", expected \"", FILE_ID_OPT, "\"",
494                                  (char *) NULL);
495            return TCL_ERROR;
496        }
497    }
498
499    if (objIdx != objc - 2)
500	return TclX_WrongArgs (interp, objv [0], "[-fileid] group filelist");
501
502    groupString = Tcl_GetStringFromObj (objv [objIdx], NULL);
503
504    if (fileIds) {
505        if (TclXOSFChangeOwnGrpObj (interp, TCLX_CHGRP, NULL, groupString,
506				objv [objIdx + 1], "chgrp - fileid") != TCL_OK)
507            goto errorExit;
508    } else {
509        if (TclXOSChangeOwnGrpObj (interp, TCLX_CHGRP, NULL, groupString,
510			       objv [objIdx + 1], "chgrp") != TCL_OK)
511            goto errorExit;
512    }
513
514    return TCL_OK;
515
516  errorExit:
517    return TCL_ERROR;
518}
519
520
521/*-----------------------------------------------------------------------------
522 * TclX_ChmodInit --
523 *     Initialize the chmod, chgrp and chown commands.
524 *-----------------------------------------------------------------------------
525 */
526void
527TclX_ChmodInit (interp)
528    Tcl_Interp *interp;
529{
530    Tcl_CreateObjCommand (interp,
531			  "chgrp",
532			  TclX_ChgrpObjCmd,
533                          (ClientData) NULL,
534			  (Tcl_CmdDeleteProc*) NULL);
535
536    Tcl_CreateObjCommand (interp,
537			  "chmod",
538			  TclX_ChmodObjCmd,
539                          (ClientData) NULL,
540			  (Tcl_CmdDeleteProc*) NULL);
541
542    Tcl_CreateObjCommand (interp,
543                          "chown",
544			  TclX_ChownObjCmd,
545                          (ClientData) NULL,
546			  (Tcl_CmdDeleteProc*) NULL);
547}
548