source: trunk/base/src/pextlib1.0/Pextlib.c @ 50962

Last change on this file since 50962 was 50962, checked in by toby@…, 8 years ago

remove mkfifo, also unused
also fix test target

  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 29.7 KB
Line 
1/*
2 * Pextlib.c
3 * $Id: Pextlib.c 50962 2009-05-14 06:34:38Z toby@macports.org $
4 *
5 * Copyright (c) 2002 - 2003 Apple Computer, Inc.
6 * Copyright (c) 2004 - 2005 Paul Guyot <pguyot@kallisys.net>
7 * Copyright (c) 2004 Landon Fuller <landonf@macports.org>
8 * All rights reserved.
9 *
10 * Redistribution and use in source and binary forms, with or without
11 * modification, are permitted provided that the following conditions
12 * are met:
13 * 1. Redistributions of source code must retain the above copyright
14 *    notice, this list of conditions and the following disclaimer.
15 * 2. Redistributions in binary form must reproduce the above copyright
16 *    notice, this list of conditions and the following disclaimer in the
17 *    documentation and/or other materials provided with the distribution.
18 * 3. Neither the name of Apple Computer, Inc. nor the names of its contributors
19 *    may be used to endorse or promote products derived from this software
20 *    without specific prior written permission.
21 *
22 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
23 * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
24 * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
25 * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
26 * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
27 * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
28 * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
29 * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
30 * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
31 * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
32 * POSSIBILITY OF SUCH DAMAGE.
33 */
34
35#if HAVE_CONFIG_H
36#include <config.h>
37#endif
38
39#include <stdint.h>
40#include <stdio.h>
41#include <stdlib.h>
42#include <ctype.h>
43#include <errno.h>
44#include <grp.h>
45
46#if HAVE_STRING_H
47#include <string.h>
48#endif
49
50#if HAVE_STRINGS_H
51#include <strings.h>
52#endif
53
54#if HAVE_DIRENT_H
55#include <dirent.h>
56#endif
57
58#if HAVE_LIMITS_H
59#include <limits.h>
60#endif
61
62#if HAVE_PATHS_H
63#include <paths.h>
64#endif
65
66#ifndef _PATH_DEVNULL
67#define _PATH_DEVNULL   "/dev/null"
68#endif
69
70#include <pwd.h>
71
72#if HAVE_SYS_FILE_H
73#include <sys/file.h>
74#endif
75
76#if HAVE_SYS_TYPES_H
77#include <sys/types.h>
78#endif
79
80#if HAVE_SYS_FCNTL_H
81#include <sys/fcntl.h>
82#endif
83
84#if HAVE_FCNTL_H
85#include <fcntl.h>
86#endif
87
88#if HAVE_SYS_WAIT_H
89#include <sys/wait.h>
90#endif
91
92#if HAVE_UNISTD_H
93#include <unistd.h>
94#endif
95
96#if HAVE_SYS_SOCKET_H
97#include <sys/socket.h>
98#endif
99
100#if HAVE_SYS_STAT_H
101#include <sys/stat.h>
102#endif
103
104#include <tcl.h>
105
106#include "md5cmd.h"
107#include "sha1cmd.h"
108#include "rmd160cmd.h"
109#include "fs-traverse.h"
110#include "filemap.h"
111#include "curl.h"
112#include "xinstall.h"
113#include "vercomp.h"
114#include "readline.h"
115#include "uid.h"
116#include "tracelib.h"
117#include "tty.h"
118#include "get_systemconfiguration_proxies.h"
119
120#if HAVE_CRT_EXTERNS_H
121#include <crt_externs.h>
122#define environ (*_NSGetEnviron())
123#else
124extern char **environ;
125#endif
126
127#if !HAVE_BZERO
128#if HAVE_MEMSET
129#define bzero(b, len) (void)memset(b, 0x00, len)
130#endif
131#endif
132
133#if !HAVE_FGETLN
134char *fgetln(FILE *stream, size_t *len);
135#endif
136
137#define CBUFSIZ 30
138
139char *ui_escape(const char *source)
140{
141        char *d, *dest;
142        const char *s;
143        int slen, dlen;
144
145        s = source;
146        slen = dlen = strlen(source) * 2 + 1;
147        d = dest = malloc(dlen);
148        if (dest == NULL) {
149                return NULL;
150        }
151        while(*s != '\0') {
152                switch(*s) {
153                        case '\\':
154                        case '}':
155                        case '{':
156                                *d = '\\';
157                                d++;
158                                *d = *s;
159                                d++;
160                                s++;
161                                break;
162                        case '\n':
163                                s++;
164                                break;
165                        default:
166                                *d = *s;
167                                d++;
168                                s++;
169                                break;
170                }
171        }
172        *d = '\0';
173        return dest;
174}
175
176int ui_info(Tcl_Interp *interp, char *mesg)
177{
178        const char ui_proc_start[] = "ui_info [subst -nocommands -novariables {";
179        const char ui_proc_end[] = "}]";
180        char *script, *string, *p;
181        int scriptlen, len, rval;
182
183        string = ui_escape(mesg);
184        if (string == NULL)
185                return TCL_ERROR;
186
187        len = strlen(string);
188        scriptlen = sizeof(ui_proc_start) + len + sizeof(ui_proc_end) - 1;
189        script = malloc(scriptlen);
190        if (script == NULL)
191                return TCL_ERROR;
192        else
193                p = script;
194
195        memcpy(script, ui_proc_start, sizeof(ui_proc_start));
196        strcat(script, string);
197        strcat(script, ui_proc_end);
198        free(string);
199        rval = Tcl_EvalEx(interp, script, scriptlen - 1, 0);
200        free(script);
201        return rval;
202}
203
204struct linebuf {
205        size_t len;
206        char *line;
207};
208
209int SystemCmd(ClientData clientData UNUSED, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
210{
211        char *buf;
212        struct linebuf circbuf[CBUFSIZ];
213        size_t linelen;
214        char *args[4];
215        char *cmdstring;
216        FILE *pdes;
217        int fdset[2], nullfd;
218        int fline, pos, ret;
219        int osetsid = 0;
220        pid_t pid;
221        Tcl_Obj *errbuf;
222        Tcl_Obj *tcl_result;
223        int read_failed, status;
224
225        /* usage: system [-notty] command */
226        if (objc == 2) {
227                cmdstring = Tcl_GetString(objv[1]);
228        } else if (objc == 3) {
229                char *arg = Tcl_GetString(objv[1]);
230                cmdstring = Tcl_GetString(objv[2]);
231
232                if (strcmp(arg, "-notty") == 0) {
233                        osetsid = 1;
234                } else {
235                        tcl_result = Tcl_NewStringObj("bad option ", -1);
236                        Tcl_AppendObjToObj(tcl_result, Tcl_NewStringObj(arg, -1));
237                        Tcl_SetObjResult(interp, tcl_result);
238                        return TCL_ERROR;
239                }
240        } else {
241                Tcl_WrongNumArgs(interp, 1, objv, "command");
242                return TCL_ERROR;
243        }
244
245        /*
246         * Fork a child to run the command, in a popen() like fashion -
247         * popen() itself is not used because stderr is also desired.
248         */
249        if (pipe(fdset) != 0) {
250                return TCL_ERROR;
251        }
252
253        pid = fork();
254        switch (pid) {
255        case -1: /* error */
256                return TCL_ERROR;
257                break;
258        case 0: /* child */
259                close(fdset[0]);
260
261                if ((nullfd = open(_PATH_DEVNULL, O_RDONLY)) == -1)
262                        _exit(1);
263                dup2(nullfd, STDIN_FILENO);
264                dup2(fdset[1], STDOUT_FILENO);
265                dup2(fdset[1], STDERR_FILENO);
266                /* drop the controlling terminal if requested */
267                if (osetsid) {
268                        if (setsid() == -1)
269                                _exit(1);
270                }
271                /* XXX ugly string constants */
272                args[0] = "sh";
273                args[1] = "-c";
274                args[2] = cmdstring;
275                args[3] = NULL;
276                execve("/bin/sh", args, environ);
277                _exit(1);
278                break;
279        default: /* parent */
280                break;
281        }
282
283        close(fdset[1]);
284
285        /* read from simulated popen() pipe */
286        read_failed = 0;
287        pos = 0;
288        bzero(circbuf, sizeof(circbuf));
289        pdes = fdopen(fdset[0], "r");
290        while ((buf = fgetln(pdes, &linelen)) != NULL) {
291                char *sbuf;
292                int slen;
293
294                /*
295                 * Allocate enough space to insert a terminating
296                 * '\0' if the line is not terminated with a '\n'
297                 */
298                if (buf[linelen - 1] == '\n')
299                        slen = linelen;
300                else
301                        slen = linelen + 1;
302
303                if (circbuf[pos].len == 0)
304                        sbuf = malloc(slen);
305                else {
306                        sbuf = realloc(circbuf[pos].line, slen);
307                }
308
309                if (sbuf == NULL) {
310                        read_failed = 1;
311                        break;
312                }
313
314                memcpy(sbuf, buf, linelen);
315                /* terminate line with '\0',replacing '\n' if it exists */
316                sbuf[slen - 1] = '\0';
317
318                circbuf[pos].line = sbuf;
319                circbuf[pos].len = slen;
320
321                if (pos++ == CBUFSIZ - 1) {
322                        pos = 0;
323                }
324
325                if (ui_info(interp, sbuf) != TCL_OK) {
326                        read_failed = 1;
327                        break;
328                }
329        }
330        fclose(pdes);
331
332        status = TCL_ERROR;
333
334        if (wait(&ret) == pid && WIFEXITED(ret) && !read_failed) {
335                /* Normal exit, and reading from the pipe didn't fail. */
336                if (WEXITSTATUS(ret) == 0) {
337                        status = TCL_OK;
338                } else {
339                        /* Copy the contents of the circular buffer to errbuf */
340                        Tcl_Obj* errorCode;
341                        errbuf = Tcl_NewStringObj(NULL, 0);
342                        for (fline = pos; pos < fline + CBUFSIZ; pos++) {
343                                if (circbuf[pos % CBUFSIZ].len == 0)
344                                continue; /* skip empty lines */
345
346                                /* Append line, minus trailing NULL */
347                                Tcl_AppendToObj(errbuf, circbuf[pos % CBUFSIZ].line,
348                                                circbuf[pos % CBUFSIZ].len - 1);
349
350                                /* Re-add previously stripped newline */
351                                Tcl_AppendToObj(errbuf, "\n", 1);
352                        }
353
354                        /* set errorCode [list CHILDSTATUS <pid> <code>] */
355                        errorCode = Tcl_NewListObj(0, NULL);
356                        Tcl_ListObjAppendElement(interp, errorCode, Tcl_NewStringObj("CHILDSTATUS", -1));
357                        Tcl_ListObjAppendElement(interp, errorCode, Tcl_NewIntObj(pid));
358                        Tcl_ListObjAppendElement(interp, errorCode, Tcl_NewIntObj(WEXITSTATUS(ret)));
359                        Tcl_SetObjErrorCode(interp, errorCode);
360
361                        /* set result */
362                        tcl_result = Tcl_NewStringObj("shell command \"", -1);
363                        Tcl_AppendToObj(tcl_result, cmdstring, -1);
364                        Tcl_AppendToObj(tcl_result, "\" returned error ", -1);
365                        Tcl_AppendObjToObj(tcl_result, Tcl_NewIntObj(WEXITSTATUS(ret)));
366                        Tcl_AppendToObj(tcl_result, "\nCommand output: ", -1);
367                        Tcl_AppendObjToObj(tcl_result, errbuf);
368                        Tcl_SetObjResult(interp, tcl_result);
369                }
370        }
371
372        /* Cleanup. */
373        close(fdset[0]);
374        for (fline = 0; fline < CBUFSIZ; fline++) {
375                if (circbuf[fline].len != 0) {
376                        free(circbuf[fline].line);
377                }
378        }
379
380        return status;
381}
382
383int SudoCmd(ClientData clientData UNUSED, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
384{
385        char *buf;
386        struct linebuf circbuf[CBUFSIZ];
387        size_t linelen;
388        char *args[4];
389        char *cmdstring, *passwd;
390        FILE *pdes;
391        int fdset[2];
392        int fline, pos, ret;
393        pid_t pid;
394        Tcl_Obj *errbuf;
395        Tcl_Obj *tcl_result;
396
397        if (objc != 3) {
398                Tcl_WrongNumArgs(interp, 1, objv, "password command");
399                return TCL_ERROR;
400        }
401        passwd = Tcl_GetString(objv[1]);
402        cmdstring = Tcl_GetString(objv[2]);
403
404        if (pipe(fdset) == -1)
405                return TCL_ERROR;
406
407        /*
408         * Fork a child to run the command, in a popen() like fashion -
409         * popen() itself is not used because stderr is also desired.
410         */
411        pid = fork();
412        if (pid == -1)
413                return TCL_ERROR;
414        if (pid == 0) {
415                dup2(fdset[0], STDIN_FILENO);
416                dup2(fdset[1], STDOUT_FILENO);
417                dup2(fdset[1], STDERR_FILENO);
418                args[0] = "sudo";
419                args[1] = "-S";
420                args[2] = cmdstring;
421                args[3] = NULL;
422                execve("/usr/bin/sudo", args, environ);
423                /* Now throw away the privs we just acquired */
424                args[1] = "-k";
425                args[2] = NULL;
426                execve("/usr/bin/sudo", args, environ);
427                _exit(1);
428        } else {
429                write(fdset[1], passwd, strlen(passwd));
430                write(fdset[1], "\n", 1);
431                close(fdset[1]);
432        }
433        pdes = fdopen(fdset[0], "r");
434
435        /* read from simulated popen() pipe */
436        pos = 0;
437        bzero(circbuf, sizeof(circbuf));
438        while ((buf = fgetln(pdes, &linelen)) != NULL) {
439                char *sbuf;
440                int slen;
441
442                /*
443                 * Allocate enough space to insert a terminating
444                 * '\0' if the line is not terminated with a '\n'
445                 */
446                if (buf[linelen - 1] == '\n')
447                        slen = linelen;
448                else
449                        slen = linelen + 1;
450
451                if (circbuf[pos].len == 0)
452                        sbuf = malloc(slen);
453                else {
454                        sbuf = realloc(circbuf[pos].line, slen);
455                }
456
457                if (sbuf == NULL) {
458                        for (fline = pos; pos < fline + CBUFSIZ; pos++) {
459                                if (circbuf[pos % CBUFSIZ].len != 0)
460                                        free(circbuf[pos % CBUFSIZ].line);
461                        }
462                        return TCL_ERROR;
463                }
464
465                memcpy(sbuf, buf, linelen);
466                /* terminate line with '\0',replacing '\n' if it exists */
467                sbuf[slen - 1] = '\0';
468
469                circbuf[pos].line = sbuf;
470                circbuf[pos].len = slen;
471
472                if (pos++ == CBUFSIZ - 1)
473                        pos = 0;
474                ret = ui_info(interp, sbuf);
475                if (ret != TCL_OK) {
476                        for (fline = pos; pos < fline + CBUFSIZ; pos++) {
477                                if (circbuf[pos % CBUFSIZ].len != 0)
478                                        free(circbuf[pos % CBUFSIZ].line);
479                        }
480                        return ret;
481                }
482        }
483        fclose(pdes);
484
485        if (wait(&ret) != pid)
486                return TCL_ERROR;
487        if (WIFEXITED(ret)) {
488                if (WEXITSTATUS(ret) == 0)
489                        return TCL_OK;
490                else {
491                        /* Copy the contents of the circular buffer to errbuf */
492                        Tcl_Obj* errorCode;
493                        errbuf = Tcl_NewStringObj(NULL, 0);
494                        for (fline = pos; pos < fline + CBUFSIZ; pos++) {
495                                if (circbuf[pos % CBUFSIZ].len == 0)
496                                continue; /* skip empty lines */
497
498                                /* Append line, minus trailing NULL */
499                                Tcl_AppendToObj(errbuf, circbuf[pos % CBUFSIZ].line,
500                                                circbuf[pos % CBUFSIZ].len - 1);
501
502                                /* Re-add previously stripped newline */
503                                Tcl_AppendToObj(errbuf, "\n", 1);
504                                free(circbuf[pos % CBUFSIZ].line);
505                        }
506
507                        /* set errorCode [list CHILDSTATUS <pid> <code>] */
508                        errorCode = Tcl_NewListObj(0, NULL);
509                        Tcl_ListObjAppendElement(interp, errorCode, Tcl_NewStringObj("CHILDSTATUS", -1));
510                        Tcl_ListObjAppendElement(interp, errorCode, Tcl_NewIntObj(pid));
511                        Tcl_ListObjAppendElement(interp, errorCode, Tcl_NewIntObj(WEXITSTATUS(ret)));
512                        Tcl_SetObjErrorCode(interp, errorCode);
513
514                        /* set result */
515                        tcl_result = Tcl_NewStringObj("sudo command \"", -1);
516                        Tcl_AppendToObj(tcl_result, cmdstring, -1);
517                        Tcl_AppendToObj(tcl_result, "\" returned error ", -1);
518                        Tcl_AppendObjToObj(tcl_result, Tcl_NewIntObj(WEXITSTATUS(ret)));
519                        Tcl_AppendToObj(tcl_result, "\nCommand output: ", -1);
520                        Tcl_AppendObjToObj(tcl_result, errbuf);
521                        Tcl_SetObjResult(interp, tcl_result);
522                        return TCL_ERROR;
523                }
524        } else
525                return TCL_ERROR;
526}
527
528int FlockCmd(ClientData clientData UNUSED, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
529{
530        static const char errorstr[] = "use one of \"-shared\", \"-exclusive\", or \"-unlock\", and optionally \"-noblock\"";
531        int operation = 0, fd, i, ret;
532        int errnoval = 0;
533        int oshared = 0, oexclusive = 0, ounlock = 0, onoblock = 0;
534#if defined(HAVE_LOCKF) && !defined(HAVE_FLOCK)
535        off_t curpos;
536#endif
537        char *res;
538        Tcl_Channel channel;
539        ClientData handle;
540
541        if (objc < 3 || objc > 4) {
542                Tcl_WrongNumArgs(interp, 1, objv, "channelId switches");
543                return TCL_ERROR;
544        }
545
546        if ((channel = Tcl_GetChannel(interp, Tcl_GetString(objv[1]), NULL)) == NULL)
547                return TCL_ERROR;
548
549        if (Tcl_GetChannelHandle(channel, TCL_READABLE|TCL_WRITABLE, &handle) != TCL_OK) {
550                Tcl_SetResult(interp, "error getting channel handle", TCL_STATIC);
551                return TCL_ERROR;
552        }
553        fd = (int)(intptr_t)handle;
554
555        for (i = 2; i < objc; i++) {
556                char *arg = Tcl_GetString(objv[i]);
557                if (!strcmp(arg, "-shared")) {
558                  oshared = 1;
559                } else if (!strcmp(arg, "-exclusive")) {
560                  oexclusive = 1;
561                } else if (!strcmp(arg, "-unlock")) {
562                  ounlock = 1;
563                } else if (!strcmp(arg, "-noblock")) {
564                  onoblock = 1;
565                }
566        }
567
568        /* verify the arguments */
569
570        if((oshared + oexclusive + ounlock) != 1) {
571          /* only one of the options should have been specified */
572          Tcl_SetResult(interp, (void *) &errorstr, TCL_STATIC);
573          return TCL_ERROR;
574        }
575
576        if(onoblock && ounlock) {
577          /* should not be specified together */
578          Tcl_SetResult(interp, "-noblock can not be used with -unlock", TCL_STATIC);
579          return TCL_ERROR;
580        }
581         
582#if HAVE_FLOCK
583        /* prefer flock if present */
584        if(oshared) operation |= LOCK_SH;
585
586        if(oexclusive) operation |= LOCK_EX;
587
588        if(ounlock) operation |= LOCK_UN;
589
590        if(onoblock) operation |= LOCK_NB;
591
592        ret = flock(fd, operation);
593        if(ret == -1) {
594          errnoval = errno;
595        }
596#else
597#if HAVE_LOCKF
598        if(ounlock) operation = F_ULOCK;
599
600        /* lockf semantics don't map to shared locks. */
601        if(oshared || oexclusive) {
602          if(onoblock) {
603            operation = F_TLOCK;
604          } else {
605            operation = F_LOCK;
606          }
607        }
608
609        curpos = lseek(fd, 0, SEEK_CUR);
610        if(curpos == -1) {
611                Tcl_SetResult(interp, (void *) "Seek error", TCL_STATIC);
612                return TCL_ERROR;
613        }
614
615        ret = lockf(fd, operation, 0); /* lock entire file */
616
617        curpos = lseek(fd, curpos, SEEK_SET);
618        if(curpos == -1) {
619                Tcl_SetResult(interp, (void *) "Seek error", TCL_STATIC);
620                return TCL_ERROR;
621        }
622
623        if(ret == -1) {
624          errnoval = errno;
625          if((oshared || oexclusive)) {
626            /* map the errno val to what we would expect for flock */
627            if(onoblock && errnoval == EAGAIN) {
628              /* on some systems, EAGAIN=EWOULDBLOCK, but lets be safe */
629              errnoval = EWOULDBLOCK;
630            } else if(errnoval == EINVAL) {
631              errnoval = EOPNOTSUPP;
632            }
633          }
634        }
635#else
636#error no available locking implementation
637#endif /* HAVE_LOCKF */
638#endif /* HAVE_FLOCK */
639
640        if (ret != 0)
641        {
642                switch(errnoval) {
643                        case EAGAIN:
644                                res = "EAGAIN";
645                                break;
646                        case EBADF:
647                                res = "EBADF";
648                                break;
649                        case EINVAL:
650                                res = "EINVAL";
651                                break;
652                        case EOPNOTSUPP:
653                                res = "EOPNOTSUPP";
654                                break;
655                        default:
656                                res = strerror(errno);
657                                break;
658                }
659                Tcl_SetResult(interp, (void *) res, TCL_STATIC);
660                return TCL_ERROR;
661        }
662        return TCL_OK;
663}
664
665/**
666 *
667 * Return the list of elements in a directory.
668 * Since 1.60.4.2, the list doesn't include . and ..
669 *
670 * Synopsis: readdir directory
671 */
672int ReaddirCmd(ClientData clientData UNUSED, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
673{
674        DIR *dirp;
675        struct dirent *mp;
676        Tcl_Obj *tcl_result;
677        char *path;
678
679        if (objc != 2) {
680                Tcl_WrongNumArgs(interp, 1, objv, "directory");
681                return TCL_ERROR;
682        }
683
684        path = Tcl_GetString(objv[1]);
685        dirp = opendir(path);
686        if (!dirp) {
687                Tcl_SetResult(interp, "Cannot read directory", TCL_STATIC);
688                return TCL_ERROR;
689        }
690        tcl_result = Tcl_NewListObj(0, NULL);
691        while ((mp = readdir(dirp))) {
692                /* Skip . and .. */
693                if ((mp->d_name[0] != '.') ||
694                        ((mp->d_name[1] != 0)   /* "." */
695                                &&
696                        ((mp->d_name[1] != '.') || (mp->d_name[2] != 0)))) /* ".." */ {
697                        Tcl_ListObjAppendElement(interp, tcl_result, Tcl_NewStringObj(mp->d_name, -1));
698                }
699        }
700        closedir(dirp);
701        Tcl_SetObjResult(interp, tcl_result);
702       
703        return TCL_OK;
704}
705
706int StrsedCmd(ClientData clientData UNUSED, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
707{
708        char *pattern, *string, *res;
709        int range[2];
710        extern char *strsed(char *str, char *pat, int *range);
711        Tcl_Obj *tcl_result;
712
713        if (objc != 3) {
714                Tcl_WrongNumArgs(interp, 1, objv, "string pattern");
715                return TCL_ERROR;
716        }
717
718        string = Tcl_GetString(objv[1]);
719        pattern = Tcl_GetString(objv[2]);
720        res = strsed(string, pattern, range);
721        if (!res) {
722                Tcl_SetResult(interp, "strsed failed", TCL_STATIC);
723                return TCL_ERROR;
724        }
725        tcl_result = Tcl_NewStringObj(res, -1);
726        Tcl_SetObjResult(interp, tcl_result);
727        free(res);
728        return TCL_OK;
729}
730
731int MkdtempCmd(ClientData clientData UNUSED, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
732{
733        char *template, *sp;
734        Tcl_Obj *tcl_result;
735
736        if (objc != 2) {
737                Tcl_WrongNumArgs(interp, 1, objv, "template");
738                return TCL_ERROR;
739        }
740
741        template = strdup(Tcl_GetString(objv[1]));
742        if (template == NULL)
743                return TCL_ERROR;
744
745        if ((sp = mkdtemp(template)) == NULL) {
746                Tcl_AppendResult(interp, "mkdtemp failed: ", strerror(errno), NULL);
747                free(template);
748                return TCL_ERROR;
749        }
750
751        tcl_result = Tcl_NewStringObj(sp, -1);
752        Tcl_SetObjResult(interp, tcl_result);
753        free(template);
754        return TCL_OK;
755}
756
757int MktempCmd(ClientData clientData UNUSED, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
758{
759        char *template, *sp;
760        Tcl_Obj *tcl_result;
761
762        if (objc != 2) {
763                Tcl_WrongNumArgs(interp, 1, objv, "template");
764                return TCL_ERROR;
765        }
766
767        template = strdup(Tcl_GetString(objv[1]));
768        if (template == NULL)
769                return TCL_ERROR;
770
771        if ((sp = mktemp(template)) == NULL) {
772                Tcl_AppendResult(interp, "mktemp failed: ", strerror(errno), NULL);
773                free(template);
774                return TCL_ERROR;
775        }
776
777        tcl_result = Tcl_NewStringObj(sp, -1);
778        Tcl_SetObjResult(interp, tcl_result);
779        free(template);
780        return TCL_OK;
781}
782
783int MkstempCmd(ClientData clientData UNUSED, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
784{
785        Tcl_Channel channel;
786        char *template, *channelname;
787        int fd;
788
789        if (objc != 2) {
790                Tcl_WrongNumArgs(interp, 1, objv, "template");
791                return TCL_ERROR;
792        }
793
794        template = strdup(Tcl_GetString(objv[1]));
795        if (template == NULL)
796                return TCL_ERROR;
797
798        if ((fd = mkstemp(template)) < 0) {
799                Tcl_AppendResult(interp, "mkstemp failed: ", strerror(errno), NULL);
800                free(template);
801                return TCL_ERROR;
802        }
803
804        channel = Tcl_MakeFileChannel((ClientData)(intptr_t)fd, TCL_READABLE|TCL_WRITABLE);
805        Tcl_RegisterChannel(interp, channel);
806        channelname = (char *)Tcl_GetChannelName(channel);
807        Tcl_AppendResult(interp, channelname, " ", template, NULL);
808        free(template);
809        return TCL_OK;
810}
811
812int ExistsuserCmd(ClientData clientData UNUSED, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
813{
814        Tcl_Obj *tcl_result;
815        struct passwd *pwent;
816        char *user;
817
818        if (objc != 2) {
819                Tcl_WrongNumArgs(interp, 1, objv, "user");
820                return TCL_ERROR;
821        }
822
823        user = strdup(Tcl_GetString(objv[1]));
824        if (isdigit(*(user)))
825                pwent = getpwuid(strtol(user, 0, 0));
826        else
827                pwent = getpwnam(user);
828        free(user);
829
830        if (pwent == NULL)
831                tcl_result = Tcl_NewIntObj(0);
832        else
833                tcl_result = Tcl_NewIntObj(pwent->pw_uid);
834
835        Tcl_SetObjResult(interp, tcl_result);
836        return TCL_OK;
837}
838
839int ExistsgroupCmd(ClientData clientData UNUSED, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
840{
841        Tcl_Obj *tcl_result;
842        struct group *grent;
843        char *group;
844
845        if (objc != 2) {
846                Tcl_WrongNumArgs(interp, 1, objv, "groupname");
847                return TCL_ERROR;
848        }
849
850        group = strdup(Tcl_GetString(objv[1]));
851        if (isdigit(*(group)))
852                grent = getgrgid(strtol(group, 0, 0));
853        else
854                grent = getgrnam(group);
855        free(group);
856
857        if (grent == NULL)
858                tcl_result = Tcl_NewIntObj(0);
859        else
860                tcl_result = Tcl_NewIntObj(grent->gr_gid);
861
862        Tcl_SetObjResult(interp, tcl_result);
863        return TCL_OK;
864}
865
866/* Find the first unused UID > 100
867   previously this would find the highest used UID and add 1
868   but UIDs > 500 are visible on the login screen of OS X */
869int NextuidCmd(ClientData clientData UNUSED, Tcl_Interp *interp, int objc UNUSED, Tcl_Obj *CONST objv[] UNUSED)
870{
871        Tcl_Obj *tcl_result;
872        int cur;
873
874        cur = MIN_USABLE_UID;
875       
876        while (getpwuid(cur) != NULL) {
877                cur++;
878        }
879       
880        tcl_result = Tcl_NewIntObj(cur);
881        Tcl_SetObjResult(interp, tcl_result);
882        return TCL_OK;
883}
884
885/* Just as with NextuidCmd, return the first unused gid > 100
886   groups aren't visible on the login screen, but I see no reason
887   to create group 502 when I can create group 100 */
888int NextgidCmd(ClientData clientData UNUSED, Tcl_Interp *interp, int objc UNUSED, Tcl_Obj *CONST objv[] UNUSED)
889{
890        Tcl_Obj *tcl_result;
891        int cur;
892
893        cur = MIN_USABLE_GID;
894
895        while (getgrgid(cur) != NULL) {
896                cur++;
897        }
898       
899        tcl_result = Tcl_NewIntObj(cur);
900        Tcl_SetObjResult(interp, tcl_result);
901        return TCL_OK;
902}
903
904int UmaskCmd(ClientData clientData UNUSED, Tcl_Interp *interp, int objc UNUSED, Tcl_Obj *CONST objv[] UNUSED)
905{
906        Tcl_Obj *tcl_result;
907        char *tcl_mask, *p;
908        const size_t stringlen = 4; /* 3 digits & \0 */
909        int i;
910        mode_t *set;
911        mode_t newmode;
912        mode_t oldmode;
913
914        if (objc != 2) {
915                Tcl_WrongNumArgs(interp, 1, objv, "numask");
916                return TCL_ERROR;
917        }
918
919        tcl_mask = Tcl_GetString(objv[1]);
920        if ((set = setmode(tcl_mask)) == NULL) {
921                Tcl_SetResult(interp, "Invalid umask mode", TCL_STATIC);
922                return TCL_ERROR;
923        }
924
925        newmode = getmode(set, 0);
926        free(set);
927
928        oldmode = umask(newmode);
929
930        tcl_mask = malloc(stringlen); /* 3 digits & \0 */
931        if (!tcl_mask) {
932                return TCL_ERROR;
933        }
934
935        /* Totally gross and cool */
936        p = tcl_mask + stringlen;
937        *p = '\0';
938        for (i = stringlen - 1; i > 0; i--) {
939                p--;
940                *p = (oldmode & 7) + '0';
941                oldmode >>= 3;
942        }
943        if (*p != '0') {
944                p--;
945                *p = '0';
946        }
947
948        tcl_result = Tcl_NewStringObj(p, -1);
949        free(tcl_mask);
950
951        Tcl_SetObjResult(interp, tcl_result);
952        return TCL_OK;
953}
954
955/**
956 * Call pipe(2) to create a pipe.
957 * Syntax is:
958 * pipe
959 *
960 * Generate a Tcl error if something goes wrong.
961 * Return a list with the file descriptors of the pipe. The first item is the
962 * readable fd.
963 */
964int PipeCmd(ClientData clientData UNUSED, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
965{
966        Tcl_Obj* result;
967        int fildes[2];
968
969        if (objc != 1) {
970                Tcl_WrongNumArgs(interp, 1, objv, NULL);
971                return TCL_ERROR;
972        }
973       
974        if (pipe(fildes) < 0) {
975                Tcl_AppendResult(interp, "pipe failed: ", strerror(errno), NULL);
976                return TCL_ERROR;
977        }
978       
979        /* build a list out of the couple */
980        result = Tcl_NewListObj(0, NULL);
981        Tcl_ListObjAppendElement(interp, result, Tcl_NewIntObj(fildes[0]));
982        Tcl_ListObjAppendElement(interp, result, Tcl_NewIntObj(fildes[1]));
983        Tcl_SetObjResult(interp, result);
984
985        return TCL_OK;
986}
987
988/**
989 * symlink value target
990 * Create a symbolic link at target pointing to value
991 * See symlink(2) for possible errors
992 */
993int CreateSymlinkCmd(ClientData clientData UNUSED, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
994{
995    char *value, *target;
996   
997    if (objc != 3) {
998        Tcl_WrongNumArgs(interp, 1, objv, "value target");
999        return TCL_ERROR;
1000    }
1001   
1002    value = Tcl_GetString(objv[1]);
1003    target = Tcl_GetString(objv[2]);
1004   
1005    if (symlink(value, target) != 0) {
1006        Tcl_SetResult(interp, (char *)Tcl_PosixError(interp), TCL_STATIC);
1007        return TCL_ERROR;
1008    }
1009    return TCL_OK;
1010}
1011
1012/**
1013 * deletes environment variable
1014 *
1015 * Syntax is:
1016 * unsetenv name (* for all)
1017 */
1018int UnsetEnvCmd(ClientData clientData UNUSED, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
1019{
1020    char *name;
1021    char **envp;
1022    char *equals;
1023    size_t len;
1024    Tcl_Obj *tclList;
1025    int listLength;
1026    Tcl_Obj **listArray;
1027    int loopCounter;
1028   
1029    if (objc != 2) {
1030        Tcl_WrongNumArgs(interp, 1, objv, "name");
1031        return TCL_ERROR;
1032    }
1033
1034    name = Tcl_GetString(objv[1]);
1035    if (strchr(name, '=') != NULL) {
1036        Tcl_SetResult(interp, "only the name should be given", TCL_STATIC);
1037        return TCL_ERROR;
1038    }
1039
1040    if (strcmp(name, "*") == 0) {
1041#ifndef HAVE_CLEARENV
1042        /* unset all current environment variables; it'd be best to use
1043           clearenv() but that is not yet standardized, instead use Tcl's
1044           list capability to easily build an array of strings for each
1045           env name, then loop through that list to unsetenv() each one */
1046        tclList = Tcl_NewListObj( 0, NULL );
1047        Tcl_IncrRefCount( tclList );
1048        /* unset all current environment variables */
1049        for (envp = environ; *envp != NULL; envp++) {
1050            equals = strchr(*envp, '=');
1051            if (equals != NULL) {
1052                len = equals - *envp;
1053                Tcl_ListObjAppendElement(interp, tclList, Tcl_NewStringObj(*envp, len));
1054            }
1055        }
1056        Tcl_ListObjGetElements(interp, tclList, &listLength, &listArray);
1057        for (loopCounter = 0; loopCounter < listLength; loopCounter++) {
1058            unsetenv(Tcl_GetString(listArray[loopCounter]));
1059        }
1060        Tcl_DecrRefCount( tclList );
1061#else
1062        clearenv();
1063#endif
1064    } else {
1065        (void) unsetenv(name);
1066    }
1067    /* Tcl appears to become out of sync with the environment when we
1068       unset things, eg, 'info exists env(CC)' will succeed where
1069       'puts $env(CC)' will fail since it doesn't actually exist after
1070       being unset here.  This forces Tcl to resync to the current state
1071       (don't care about the actual result, so reset it) */
1072    Tcl_Eval(interp, "array get env");
1073    Tcl_ResetResult(interp);
1074
1075    return TCL_OK;
1076}
1077
1078/**
1079 *
1080 * Tcl wrapper around lchown() to allow changing ownership of symlinks
1081 * ('file attributes' follows the symlink).
1082 *
1083 * Synopsis: lchown filename user ?group?
1084 */
1085int lchownCmd(ClientData clientData UNUSED, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
1086{
1087    CONST char *path;
1088    long user;
1089    long group = -1;
1090
1091    if (objc != 3 && objc != 4) {
1092        Tcl_WrongNumArgs(interp, 1, objv, "filename user ?group?");
1093        return TCL_ERROR;
1094    }
1095
1096    path = Tcl_GetString(objv[1]);
1097    if (Tcl_GetLongFromObj(NULL, objv[2], &user) != TCL_OK) {
1098        CONST char *userString = Tcl_GetString(objv[2]);
1099        struct passwd *pwent = getpwnam(userString);
1100        if (pwent == NULL) {
1101            Tcl_SetResult(interp, "Unknown user given", TCL_STATIC);
1102            return TCL_ERROR;
1103        }
1104        user = pwent->pw_uid;
1105    }
1106    if (objc == 4) {
1107        if (Tcl_GetLongFromObj(NULL, objv[3], &group) != TCL_OK) {
1108           CONST char *groupString = Tcl_GetString(objv[3]);
1109           struct group *grent = getgrnam(groupString);
1110           if (grent == NULL) {
1111               Tcl_SetResult(interp, "Unknown group given", TCL_STATIC);
1112               return TCL_ERROR;
1113           }
1114           group = grent->gr_gid;
1115        }
1116    }
1117    if (lchown(path, (uid_t) user, (gid_t) group) != 0) {
1118        Tcl_SetResult(interp, (char *)Tcl_PosixError(interp), TCL_STATIC);
1119        return TCL_ERROR;
1120    }
1121
1122    return TCL_OK;
1123}
1124
1125int Pextlib_Init(Tcl_Interp *interp)
1126{
1127        if (Tcl_InitStubs(interp, "8.3", 0) == NULL)
1128                return TCL_ERROR;
1129
1130        Tcl_CreateObjCommand(interp, "system", SystemCmd, NULL, NULL);
1131        Tcl_CreateObjCommand(interp, "flock", FlockCmd, NULL, NULL);
1132        Tcl_CreateObjCommand(interp, "readdir", ReaddirCmd, NULL, NULL);
1133        Tcl_CreateObjCommand(interp, "strsed", StrsedCmd, NULL, NULL);
1134        Tcl_CreateObjCommand(interp, "mkstemp", MkstempCmd, NULL, NULL);
1135        Tcl_CreateObjCommand(interp, "mktemp", MktempCmd, NULL, NULL);
1136        Tcl_CreateObjCommand(interp, "mkdtemp", MkdtempCmd, NULL, NULL);
1137        Tcl_CreateObjCommand(interp, "existsuser", ExistsuserCmd, NULL, NULL);
1138        Tcl_CreateObjCommand(interp, "existsgroup", ExistsgroupCmd, NULL, NULL);
1139        Tcl_CreateObjCommand(interp, "nextuid", NextuidCmd, NULL, NULL);
1140        Tcl_CreateObjCommand(interp, "nextgid", NextgidCmd, NULL, NULL);
1141        Tcl_CreateObjCommand(interp, "md5", MD5Cmd, NULL, NULL);
1142        Tcl_CreateObjCommand(interp, "xinstall", InstallCmd, NULL, NULL);
1143        Tcl_CreateObjCommand(interp, "fs-traverse", FsTraverseCmd, NULL, NULL);
1144        Tcl_CreateObjCommand(interp, "filemap", FilemapCmd, NULL, NULL);
1145        Tcl_CreateObjCommand(interp, "rpm-vercomp", RPMVercompCmd, NULL, NULL);
1146        Tcl_CreateObjCommand(interp, "rmd160", RMD160Cmd, NULL, NULL);
1147        Tcl_CreateObjCommand(interp, "sha1", SHA1Cmd, NULL, NULL);
1148        Tcl_CreateObjCommand(interp, "umask", UmaskCmd, NULL, NULL);
1149        Tcl_CreateObjCommand(interp, "sudo", SudoCmd, NULL, NULL);
1150        Tcl_CreateObjCommand(interp, "pipe", PipeCmd, NULL, NULL);
1151        Tcl_CreateObjCommand(interp, "curl", CurlCmd, NULL, NULL);
1152        Tcl_CreateObjCommand(interp, "symlink", CreateSymlinkCmd, NULL, NULL);
1153        Tcl_CreateObjCommand(interp, "unsetenv", UnsetEnvCmd, NULL, NULL);
1154        Tcl_CreateObjCommand(interp, "lchown", lchownCmd, NULL, NULL);
1155       
1156        Tcl_CreateObjCommand(interp, "readline", ReadlineCmd, NULL, NULL);
1157        Tcl_CreateObjCommand(interp, "rl_history", RLHistoryCmd, NULL, NULL);
1158       
1159        Tcl_CreateObjCommand(interp, "getuid", getuidCmd, NULL, NULL);
1160        Tcl_CreateObjCommand(interp, "geteuid", geteuidCmd, NULL, NULL);
1161        Tcl_CreateObjCommand(interp, "getgid", getgidCmd, NULL, NULL);
1162        Tcl_CreateObjCommand(interp, "getegid", getegidCmd, NULL, NULL);
1163        Tcl_CreateObjCommand(interp, "setuid", setuidCmd, NULL, NULL);
1164        Tcl_CreateObjCommand(interp, "seteuid", seteuidCmd, NULL, NULL);
1165        Tcl_CreateObjCommand(interp, "setgid", setgidCmd, NULL, NULL);
1166        Tcl_CreateObjCommand(interp, "setegid", setegidCmd, NULL, NULL);
1167        Tcl_CreateObjCommand(interp, "name_to_uid", name_to_uidCmd, NULL, NULL);
1168        Tcl_CreateObjCommand(interp, "uid_to_name", uid_to_nameCmd, NULL, NULL);
1169        Tcl_CreateObjCommand(interp, "name_to_gid", name_to_gidCmd, NULL, NULL);
1170        Tcl_CreateObjCommand(interp, "gid_to_name", gid_to_nameCmd, NULL, NULL);
1171       
1172        Tcl_CreateObjCommand(interp, "tracelib", TracelibCmd, NULL, NULL);
1173        Tcl_CreateObjCommand(interp, "isatty", IsattyCmd, NULL, NULL);
1174        Tcl_CreateObjCommand(interp, "term_get_size", TermGetSizeCmd, NULL, NULL);
1175        Tcl_CreateObjCommand(interp, "get_systemconfiguration_proxies", GetSystemConfigurationProxiesCmd, NULL, NULL);
1176
1177        if (Tcl_PkgProvide(interp, "Pextlib", "1.0") != TCL_OK)
1178                return TCL_ERROR;
1179
1180        /* init libcurl */
1181        CurlInit(interp);
1182
1183        return TCL_OK;
1184}
Note: See TracBrowser for help on using the repository browser.