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

Last change on this file since 15730 was 15730, checked in by jberry, 15 years ago

Add readline and rl_history support to pextlib
Part of merge from branch jberry-preview-13

  • Property svn:eol-style set to native
File size: 27.2 KB
Line 
1/*
2 * Pextlib.c
3 * $Id: Pextlib.c,v 1.84 2006/01/07 23:08:58 jberry Exp $
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@opendarwin.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 <stdio.h>
40#include <stdlib.h>
41#include <ctype.h>
42#include <errno.h>
43#include <grp.h>
44
45#if HAVE_STRING_H
46#include <string.h>
47#endif
48
49#if HAVE_STRINGS_H
50#include <strings.h>
51#endif
52
53#if HAVE_DIRENT_H
54#include <dirent.h>
55#endif
56
57#if HAVE_LIMITS_H
58#include <limits.h>
59#endif
60
61#if HAVE_PATHS_H
62#include <paths.h>
63#endif
64
65#ifndef _PATH_DEVNULL
66#define _PATH_DEVNULL   "/dev/null"
67#endif
68
69#include <pwd.h>
70
71#if HAVE_SYS_FILE_H
72#include <sys/file.h>
73#endif
74
75#if HAVE_SYS_TYPES_H
76#include <sys/types.h>
77#endif
78
79#if HAVE_SYS_FCNTL_H
80#include <sys/fcntl.h>
81#endif
82
83#if HAVE_FCNTL_H
84#include <fcntl.h>
85#endif
86
87#if HAVE_SYS_WAIT_H
88#include <sys/wait.h>
89#endif
90
91#if HAVE_UNISTD_H
92#include <unistd.h>
93#endif
94
95#if HAVE_SYS_SOCKET_H
96#include <sys/socket.h>
97#endif
98
99#if HAVE_SYS_STAT_H
100#include <sys/stat.h>
101#endif
102
103#include <tcl.h>
104
105#include "md5cmd.h"
106#include "sha1cmd.h"
107#include "rmd160cmd.h"
108#include "find.h"
109#include "filemap.h"
110#include "curl.h"
111#include "xinstall.h"
112#include "vercomp.h"
113#include "compat.h"
114#include "readline.h"
115
116#if HAVE_CRT_EXTERNS_H
117#include <crt_externs.h>
118#define environ (*_NSGetEnviron())
119#else
120extern char **environ;
121#endif
122
123#if !HAVE_BZERO
124#if HAVE_MEMSET
125#define bzero(b, len) (void)memset(b, 0x00, len)
126#endif
127#endif
128
129#if !HAVE_FGETLN
130char *fgetln(FILE *stream, size_t *len);
131#endif
132
133#define CBUFSIZ 30
134
135char *ui_escape(const char *source)
136{
137        char *d, *dest;
138        const char *s;
139        int slen, dlen;
140
141        s = source;
142        slen = dlen = strlen(source) * 2 + 1;
143        d = dest = malloc(dlen);
144        if (dest == NULL) {
145                return NULL;
146        }
147        while(*s != '\0') {
148                switch(*s) {
149                        case '\\':
150                        case '}':
151                        case '{':
152                                *d = '\\';
153                                d++;
154                                *d = *s;
155                                d++;
156                                s++;
157                                break;
158                        case '\n':
159                                s++;
160                                break;
161                        default:
162                                *d = *s;
163                                d++;
164                                s++;
165                                break;
166                }
167        }
168        *d = '\0';
169        return dest;
170}
171
172int ui_info(Tcl_Interp *interp, char *mesg)
173{
174        const char ui_proc_start[] = "ui_info [subst -nocommands -novariables {";
175        const char ui_proc_end[] = "}]";
176        char *script, *string, *p;
177        int scriptlen, len, rval;
178
179        string = ui_escape(mesg);
180        if (string == NULL)
181                return TCL_ERROR;
182
183        len = strlen(string);
184        scriptlen = sizeof(ui_proc_start) + len + sizeof(ui_proc_end) - 1;
185        script = malloc(scriptlen);
186        if (script == NULL)
187                return TCL_ERROR;
188        else
189                p = script;
190
191        memcpy(script, ui_proc_start, sizeof(ui_proc_start));
192        strcat(script, string);
193        strcat(script, ui_proc_end);
194        free(string);
195        rval = Tcl_EvalEx(interp, script, scriptlen - 1, 0);
196        free(script);
197        return rval;
198}
199
200struct linebuf {
201        size_t len;
202        char *line;
203};
204
205int SystemCmd(ClientData clientData UNUSED, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
206{
207        char *buf;
208        struct linebuf circbuf[CBUFSIZ];
209        size_t linelen;
210        char *args[4];
211        char *cmdstring;
212        FILE *pdes;
213        int fdset[2], nullfd;
214        int fline, pos, ret;
215        int osetsid = 0;
216        pid_t pid;
217        Tcl_Obj *errbuf;
218        Tcl_Obj *tcl_result;
219
220        if (objc != 2 && objc != 3) {
221                Tcl_WrongNumArgs(interp, 1, objv, "command");
222                return TCL_ERROR;
223        }
224       
225        if (objc == 3) {
226                char *arg = Tcl_GetString(objv[1]);
227                cmdstring = Tcl_GetString(objv[2]);
228
229                if (!strcmp(arg, "-notty")) {
230                        osetsid = 1;
231                } else {
232                        tcl_result = Tcl_NewStringObj("bad option ", -1);
233                        Tcl_AppendObjToObj(tcl_result, Tcl_NewStringObj(arg, -1));
234                        Tcl_SetObjResult(interp, tcl_result);
235                        return TCL_ERROR;
236                }
237        } else {
238                cmdstring = Tcl_GetString(objv[1]);
239        }
240
241        if (pipe(fdset) == -1)
242                return TCL_ERROR;
243
244        /*
245         * Fork a child to run the command, in a popen() like fashion -
246         * popen() itself is not used because stderr is also desired.
247         */
248        pid = fork();
249        if (pid == -1)
250                return TCL_ERROR;
251        if (pid == 0) {
252                close(fdset[0]);
253                if ((nullfd = open(_PATH_DEVNULL, O_RDONLY)) == -1)
254                        _exit(1);
255                dup2(nullfd, STDIN_FILENO);
256                dup2(fdset[1], STDOUT_FILENO);
257                dup2(fdset[1], STDERR_FILENO);
258                /* drop the controlling terminal if requested */
259                if (osetsid) {
260                        if (setsid() == -1)
261                                _exit(1);
262                }
263                /* XXX ugly string constants */
264                args[0] = "sh";
265                args[1] = "-c";
266                args[2] = cmdstring;
267                args[3] = NULL;
268                execve("/bin/sh", args, environ);
269                _exit(1);
270        }
271        close(fdset[1]);
272        pdes = fdopen(fdset[0], "r");
273
274        /* read from simulated popen() pipe */
275        pos = 0;
276        bzero(circbuf, sizeof(circbuf));
277        while ((buf = fgetln(pdes, &linelen)) != NULL) {
278                char *sbuf;
279                int slen;
280
281                /*
282                 * Allocate enough space to insert a terminating
283                 * '\0' if the line is not terminated with a '\n'
284                 */
285                if (buf[linelen - 1] == '\n')
286                        slen = linelen;
287                else
288                        slen = linelen + 1;
289
290                if (circbuf[pos].len == 0)
291                        sbuf = malloc(slen);
292                else {
293                        sbuf = realloc(circbuf[pos].line, slen);
294                }
295
296                if (sbuf == NULL) {
297                        for (fline = pos; pos < fline + CBUFSIZ; pos++) {
298                                if (circbuf[pos % CBUFSIZ].len != 0)
299                                        free(circbuf[pos % CBUFSIZ].line);
300                        }
301                        return TCL_ERROR;
302                }
303
304                memcpy(sbuf, buf, linelen);
305                /* terminate line with '\0',replacing '\n' if it exists */
306                sbuf[slen - 1] = '\0';
307
308                circbuf[pos].line = sbuf;
309                circbuf[pos].len = slen;
310
311                if (pos++ == CBUFSIZ - 1)
312                        pos = 0;
313                ret = ui_info(interp, sbuf);
314                if (ret != TCL_OK) {
315                        for (fline = pos; pos < fline + CBUFSIZ; pos++) {
316                                if (circbuf[pos % CBUFSIZ].len != 0)
317                                        free(circbuf[pos % CBUFSIZ].line);
318                        }
319                        return ret;
320                }
321        }
322        fclose(pdes);
323
324        if (wait(&ret) != pid)
325                return TCL_ERROR;
326        if (WIFEXITED(ret)) {
327                if (WEXITSTATUS(ret) == 0)
328                        return TCL_OK;
329                else {
330                        /* Copy the contents of the circular buffer to errbuf */
331                        Tcl_Obj* errorCode;
332                        errbuf = Tcl_NewStringObj(NULL, 0);
333                        for (fline = pos; pos < fline + CBUFSIZ; pos++) {
334                                if (circbuf[pos % CBUFSIZ].len == 0)
335                                continue; /* skip empty lines */
336
337                                /* Append line, minus trailing NULL */
338                                Tcl_AppendToObj(errbuf, circbuf[pos % CBUFSIZ].line,
339                                                circbuf[pos % CBUFSIZ].len - 1);
340
341                                /* Re-add previously stripped newline */
342                                Tcl_AppendToObj(errbuf, "\n", 1);
343                                free(circbuf[pos % CBUFSIZ].line);
344                        }
345
346                        /* set errorCode [list CHILDSTATUS <pid> <code>] */
347                        errorCode = Tcl_NewListObj(0, NULL);
348                        Tcl_ListObjAppendElement(interp, errorCode, Tcl_NewStringObj("CHILDSTATUS", -1));
349                        Tcl_ListObjAppendElement(interp, errorCode, Tcl_NewIntObj(pid));
350                        Tcl_ListObjAppendElement(interp, errorCode, Tcl_NewIntObj(WEXITSTATUS(ret)));
351                        Tcl_SetObjErrorCode(interp, errorCode);
352
353                        /* set result */
354                        tcl_result = Tcl_NewStringObj("shell command \"", -1);
355                        Tcl_AppendToObj(tcl_result, cmdstring, -1);
356                        Tcl_AppendToObj(tcl_result, "\" returned error ", -1);
357                        Tcl_AppendObjToObj(tcl_result, Tcl_NewIntObj(WEXITSTATUS(ret)));
358                        Tcl_AppendToObj(tcl_result, "\nCommand output: ", -1);
359                        Tcl_AppendObjToObj(tcl_result, errbuf);
360                        Tcl_SetObjResult(interp, tcl_result);
361                        return TCL_ERROR;
362                }
363        } else
364                return TCL_ERROR;
365}
366
367int SudoCmd(ClientData clientData UNUSED, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
368{
369        char *buf;
370        struct linebuf circbuf[CBUFSIZ];
371        size_t linelen;
372        char *args[4];
373        char *cmdstring, *passwd;
374        FILE *pdes;
375        int fdset[2];
376        int fline, pos, ret;
377        pid_t pid;
378        Tcl_Obj *errbuf;
379        Tcl_Obj *tcl_result;
380
381        if (objc != 3) {
382                Tcl_WrongNumArgs(interp, 1, objv, "password command");
383                return TCL_ERROR;
384        }
385        passwd = Tcl_GetString(objv[1]);
386        cmdstring = Tcl_GetString(objv[2]);
387
388        if (pipe(fdset) == -1)
389                return TCL_ERROR;
390
391        /*
392         * Fork a child to run the command, in a popen() like fashion -
393         * popen() itself is not used because stderr is also desired.
394         */
395        pid = fork();
396        if (pid == -1)
397                return TCL_ERROR;
398        if (pid == 0) {
399                dup2(fdset[0], STDIN_FILENO);
400                dup2(fdset[1], STDOUT_FILENO);
401                dup2(fdset[1], STDERR_FILENO);
402                args[0] = "sudo";
403                args[1] = "-S";
404                args[2] = cmdstring;
405                args[3] = NULL;
406                execve("/usr/bin/sudo", args, environ);
407                /* Now throw away the privs we just acquired */
408                args[1] = "-k";
409                args[2] = NULL;
410                execve("/usr/bin/sudo", args, environ);
411                _exit(1);
412        } else {
413                write(fdset[1], passwd, strlen(passwd));
414                write(fdset[1], "\n", 1);
415                close(fdset[1]);
416        }
417        pdes = fdopen(fdset[0], "r");
418
419        /* read from simulated popen() pipe */
420        pos = 0;
421        bzero(circbuf, sizeof(circbuf));
422        while ((buf = fgetln(pdes, &linelen)) != NULL) {
423                char *sbuf;
424                int slen;
425
426                /*
427                 * Allocate enough space to insert a terminating
428                 * '\0' if the line is not terminated with a '\n'
429                 */
430                if (buf[linelen - 1] == '\n')
431                        slen = linelen;
432                else
433                        slen = linelen + 1;
434
435                if (circbuf[pos].len == 0)
436                        sbuf = malloc(slen);
437                else {
438                        sbuf = realloc(circbuf[pos].line, slen);
439                }
440
441                if (sbuf == NULL) {
442                        for (fline = pos; pos < fline + CBUFSIZ; pos++) {
443                                if (circbuf[pos % CBUFSIZ].len != 0)
444                                        free(circbuf[pos % CBUFSIZ].line);
445                        }
446                        return TCL_ERROR;
447                }
448
449                memcpy(sbuf, buf, linelen);
450                /* terminate line with '\0',replacing '\n' if it exists */
451                sbuf[slen - 1] = '\0';
452
453                circbuf[pos].line = sbuf;
454                circbuf[pos].len = slen;
455
456                if (pos++ == CBUFSIZ - 1)
457                        pos = 0;
458                ret = ui_info(interp, sbuf);
459                if (ret != TCL_OK) {
460                        for (fline = pos; pos < fline + CBUFSIZ; pos++) {
461                                if (circbuf[pos % CBUFSIZ].len != 0)
462                                        free(circbuf[pos % CBUFSIZ].line);
463                        }
464                        return ret;
465                }
466        }
467        fclose(pdes);
468
469        if (wait(&ret) != pid)
470                return TCL_ERROR;
471        if (WIFEXITED(ret)) {
472                if (WEXITSTATUS(ret) == 0)
473                        return TCL_OK;
474                else {
475                        /* Copy the contents of the circular buffer to errbuf */
476                        Tcl_Obj* errorCode;
477                        errbuf = Tcl_NewStringObj(NULL, 0);
478                        for (fline = pos; pos < fline + CBUFSIZ; pos++) {
479                                if (circbuf[pos % CBUFSIZ].len == 0)
480                                continue; /* skip empty lines */
481
482                                /* Append line, minus trailing NULL */
483                                Tcl_AppendToObj(errbuf, circbuf[pos % CBUFSIZ].line,
484                                                circbuf[pos % CBUFSIZ].len - 1);
485
486                                /* Re-add previously stripped newline */
487                                Tcl_AppendToObj(errbuf, "\n", 1);
488                                free(circbuf[pos % CBUFSIZ].line);
489                        }
490
491                        /* set errorCode [list CHILDSTATUS <pid> <code>] */
492                        errorCode = Tcl_NewListObj(0, NULL);
493                        Tcl_ListObjAppendElement(interp, errorCode, Tcl_NewStringObj("CHILDSTATUS", -1));
494                        Tcl_ListObjAppendElement(interp, errorCode, Tcl_NewIntObj(pid));
495                        Tcl_ListObjAppendElement(interp, errorCode, Tcl_NewIntObj(WEXITSTATUS(ret)));
496                        Tcl_SetObjErrorCode(interp, errorCode);
497
498                        /* set result */
499                        tcl_result = Tcl_NewStringObj("sudo command \"", -1);
500                        Tcl_AppendToObj(tcl_result, cmdstring, -1);
501                        Tcl_AppendToObj(tcl_result, "\" returned error ", -1);
502                        Tcl_AppendObjToObj(tcl_result, Tcl_NewIntObj(WEXITSTATUS(ret)));
503                        Tcl_AppendToObj(tcl_result, "\nCommand output: ", -1);
504                        Tcl_AppendObjToObj(tcl_result, errbuf);
505                        Tcl_SetObjResult(interp, tcl_result);
506                        return TCL_ERROR;
507                }
508        } else
509                return TCL_ERROR;
510}
511
512int FlockCmd(ClientData clientData UNUSED, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
513{
514        static const char errorstr[] = "use one of \"-shared\", \"-exclusive\", or \"-unlock\", and optionally \"-noblock\"";
515        int operation = 0, fd, i, ret;
516        int errnoval = 0;
517        int oshared = 0, oexclusive = 0, ounlock = 0, onoblock = 0;
518#if defined(HAVE_LOCKF) && !defined(HAVE_FLOCK)
519        off_t curpos;
520#endif
521        char *res;
522        Tcl_Channel channel;
523        ClientData handle;
524
525        if (objc < 3 || objc > 4) {
526                Tcl_WrongNumArgs(interp, 1, objv, "channelId switches");
527                return TCL_ERROR;
528        }
529
530        if ((channel = Tcl_GetChannel(interp, Tcl_GetString(objv[1]), NULL)) == NULL)
531                return TCL_ERROR;
532
533        if (Tcl_GetChannelHandle(channel, TCL_READABLE|TCL_WRITABLE, &handle) != TCL_OK) {
534                Tcl_SetResult(interp, "error getting channel handle", TCL_STATIC);
535                return TCL_ERROR;
536        }
537        fd = (int) handle;
538
539        for (i = 2; i < objc; i++) {
540                char *arg = Tcl_GetString(objv[i]);
541                if (!strcmp(arg, "-shared")) {
542                  oshared = 1;
543                } else if (!strcmp(arg, "-exclusive")) {
544                  oexclusive = 1;
545                } else if (!strcmp(arg, "-unlock")) {
546                  ounlock = 1;
547                } else if (!strcmp(arg, "-noblock")) {
548                  onoblock = 1;
549                }
550        }
551
552        /* verify the arguments */
553
554        if((oshared + oexclusive + ounlock) != 1) {
555          /* only one of the options should have been specified */
556          Tcl_SetResult(interp, (void *) &errorstr, TCL_STATIC);
557          return TCL_ERROR;
558        }
559
560        if(onoblock && ounlock) {
561          /* should not be specified together */
562          Tcl_SetResult(interp, "-noblock can not be used with -unlock", TCL_STATIC);
563          return TCL_ERROR;
564        }
565         
566#if HAVE_FLOCK
567        /* prefer flock if present */
568        if(oshared) operation |= LOCK_SH;
569
570        if(oexclusive) operation |= LOCK_EX;
571
572        if(ounlock) operation |= LOCK_UN;
573
574        if(onoblock) operation |= LOCK_NB;
575
576        ret = flock(fd, operation);
577        if(ret == -1) {
578          errnoval = errno;
579        }
580#else
581#if HAVE_LOCKF
582        if(ounlock) operation = F_ULOCK;
583
584        /* lockf semantics don't map to shared locks. */
585        if(oshared || oexclusive) {
586          if(onoblock) {
587            operation = F_TLOCK;
588          } else {
589            operation = F_LOCK;
590          }
591        }
592
593        curpos = lseek(fd, 0, SEEK_CUR);
594        if(curpos == -1) {
595                Tcl_SetResult(interp, (void *) "Seek error", TCL_STATIC);
596                return TCL_ERROR;
597        }
598
599        ret = lockf(fd, operation, 0); /* lock entire file */
600
601        curpos = lseek(fd, curpos, SEEK_SET);
602        if(curpos == -1) {
603                Tcl_SetResult(interp, (void *) "Seek error", TCL_STATIC);
604                return TCL_ERROR;
605        }
606
607        if(ret == -1) {
608          errnoval = errno;
609          if((oshared || oexclusive)) {
610            /* map the errno val to what we would expect for flock */
611            if(onoblock && errnoval == EAGAIN) {
612              /* on some systems, EAGAIN=EWOULDBLOCK, but lets be safe */
613              errnoval = EWOULDBLOCK;
614            } else if(errnoval == EINVAL) {
615              errnoval = EOPNOTSUPP;
616            }
617          }
618        }
619#else
620#error no available locking implementation
621#endif /* HAVE_LOCKF */
622#endif /* HAVE_FLOCK */
623
624        if (ret != 0)
625        {
626                switch(errnoval) {
627                        case EAGAIN:
628                                res = "EAGAIN";
629                                break;
630                        case EBADF:
631                                res = "EBADF";
632                                break;
633                        case EINVAL:
634                                res = "EINVAL";
635                                break;
636                        case EOPNOTSUPP:
637                                res = "EOPNOTSUPP";
638                                break;
639                        default:
640                                res = strerror(errno);
641                                break;
642                }
643                Tcl_SetResult(interp, (void *) res, TCL_STATIC);
644                return TCL_ERROR;
645        }
646        return TCL_OK;
647}
648
649/**
650 *
651 * Return the list of elements in a directory.
652 * Since 1.60.4.2, the list doesn't include . and ..
653 *
654 * Synopsis: readdir directory
655 */
656int ReaddirCmd(ClientData clientData UNUSED, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
657{
658        DIR *dirp;
659        struct dirent *dp;
660        Tcl_Obj *tcl_result;
661        char *path;
662
663        if (objc != 2) {
664                Tcl_WrongNumArgs(interp, 1, objv, "directory");
665                return TCL_ERROR;
666        }
667
668        path = Tcl_GetString(objv[1]);
669        dirp = opendir(path);
670        if (!dirp) {
671                Tcl_SetResult(interp, "Cannot read directory", TCL_STATIC);
672                return TCL_ERROR;
673        }
674        tcl_result = Tcl_NewListObj(0, NULL);
675        while ((dp = readdir(dirp))) {
676                /* Skip . and .. */
677                if ((dp->d_name[0] != '.') ||
678                        ((dp->d_name[1] != 0)   /* "." */
679                                &&
680                        ((dp->d_name[1] != '.') || (dp->d_name[2] != 0)))) /* ".." */ {
681                        Tcl_ListObjAppendElement(interp, tcl_result, Tcl_NewStringObj(dp->d_name, -1));
682                }
683        }
684        closedir(dirp);
685        Tcl_SetObjResult(interp, tcl_result);
686       
687        return TCL_OK;
688}
689
690int StrsedCmd(ClientData clientData UNUSED, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
691{
692        char *pattern, *string, *res;
693        int range[2];
694        extern char *strsed(char *str, char *pat, int *range);
695        Tcl_Obj *tcl_result;
696
697        if (objc != 3) {
698                Tcl_WrongNumArgs(interp, 1, objv, "string pattern");
699                return TCL_ERROR;
700        }
701
702        string = Tcl_GetString(objv[1]);
703        pattern = Tcl_GetString(objv[2]);
704        res = strsed(string, pattern, range);
705        if (!res) {
706                Tcl_SetResult(interp, "strsed failed", TCL_STATIC);
707                return TCL_ERROR;
708        }
709        tcl_result = Tcl_NewStringObj(res, -1);
710        Tcl_SetObjResult(interp, tcl_result);
711        free(res);
712        return TCL_OK;
713}
714
715/**
716 * Take a file descriptor and generate a Tcl channel out of it.
717 * Syntax is:
718 * mkchannelfromfd fd [r|w|rw]
719 * Use r to generate a read-only channel, w for a write only channel or rw
720 * for a read/write channel (the default).
721 */
722int MkChannelFromFdCmd(ClientData clientData UNUSED, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
723{
724        Tcl_Channel theChannel;
725        int fd;
726        int readOrWrite = TCL_READABLE | TCL_WRITABLE;
727
728        if ((objc != 2) && (objc != 3)) {
729                Tcl_WrongNumArgs(interp, 1, objv, "fd [r|w|rw]");
730                return TCL_ERROR;
731        }
732       
733        if (objc == 3) {
734                char* readOrWrite_as_char_star;
735                readOrWrite_as_char_star = strdup(Tcl_GetString(objv[2]));
736                if (readOrWrite_as_char_star == NULL) {
737                        return TCL_ERROR;
738                }
739
740                if ((readOrWrite_as_char_star[0] == 'r')
741                        && (readOrWrite_as_char_star[1] == '\0')) {
742                        readOrWrite = TCL_READABLE;
743                } else if ((readOrWrite_as_char_star[0] == 'w')
744                        && (readOrWrite_as_char_star[1] == '\0')) {
745                        readOrWrite = TCL_WRITABLE;
746                } else if ((readOrWrite_as_char_star[0] == 'r')
747                        && (readOrWrite_as_char_star[1] == 'w')
748                        && (readOrWrite_as_char_star[2] == '\0')) {
749                        readOrWrite = TCL_READABLE | TCL_WRITABLE;
750                } else {
751                        Tcl_AppendResult(interp, "Bad mode. Use r, w or rw", NULL);
752                        free(readOrWrite_as_char_star);
753                        return TCL_ERROR;
754                }
755
756                free(readOrWrite_as_char_star);
757        }
758
759        {
760                char* fd_as_char_star;
761                fd_as_char_star = strdup(Tcl_GetString(objv[1]));
762                if (fd_as_char_star == NULL) {
763                        return TCL_ERROR;
764                }
765
766                if (Tcl_GetInt(interp, fd_as_char_star, &fd) != TCL_OK) {
767                        free(fd_as_char_star);
768                        return TCL_ERROR;
769                }
770                free(fd_as_char_star);
771        }
772
773        theChannel = Tcl_MakeFileChannel((ClientData) fd, readOrWrite);
774        if (theChannel == NULL) {
775                return TCL_ERROR;
776        }
777       
778        /* register the channel in the current interpreter */
779        Tcl_RegisterChannel(interp, theChannel);
780        Tcl_AppendResult(interp, Tcl_GetChannelName(theChannel), (char *) NULL);
781
782        return TCL_OK;
783}
784
785int MktempCmd(ClientData clientData UNUSED, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
786{
787        char *template, *sp;
788        Tcl_Obj *tcl_result;
789
790        if (objc != 2) {
791                Tcl_WrongNumArgs(interp, 1, objv, "template");
792                return TCL_ERROR;
793        }
794
795        template = strdup(Tcl_GetString(objv[1]));
796        if (template == NULL)
797                return TCL_ERROR;
798
799        if ((sp = mktemp(template)) == NULL) {
800                Tcl_AppendResult(interp, "mktemp failed: ", strerror(errno), NULL);
801                free(template);
802                return TCL_ERROR;
803        }
804
805        tcl_result = Tcl_NewStringObj(sp, -1);
806        Tcl_SetObjResult(interp, tcl_result);
807        free(sp);
808        free(template);
809        return TCL_OK;
810}
811
812int MkstempCmd(ClientData clientData UNUSED, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
813{
814        Tcl_Channel channel;
815        char *template, *channelname;
816        int fd;
817
818        if (objc != 2) {
819                Tcl_WrongNumArgs(interp, 1, objv, "template");
820                return TCL_ERROR;
821        }
822
823        template = strdup(Tcl_GetString(objv[1]));
824        if (template == NULL)
825                return TCL_ERROR;
826
827        if ((fd = mkstemp(template)) < 0) {
828                Tcl_AppendResult(interp, "mkstemp failed: ", strerror(errno), NULL);
829                free(template);
830                return TCL_ERROR;
831        }
832
833        channel = Tcl_MakeFileChannel((ClientData) fd, TCL_READABLE|TCL_WRITABLE);
834        Tcl_RegisterChannel(interp, channel);
835        channelname = (char *)Tcl_GetChannelName(channel);
836        Tcl_AppendResult(interp, channelname, " ", template, NULL);
837        free(template);
838        return TCL_OK;
839}
840
841/**
842 * Call mkfifo(2).
843 * Generate a Tcl error if something wrong occurred.
844 *
845 * Syntax is:
846 * mkfifo path mode
847 */
848int MkfifoCmd(ClientData clientData UNUSED, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
849{
850        char* path;
851        mode_t mode;
852
853        if (objc != 3) {
854                Tcl_WrongNumArgs(interp, 1, objv, "path mode");
855                return TCL_ERROR;
856        }
857       
858        {
859                char* mode_as_char_star;
860                int mode_as_int;
861                mode_as_char_star = strdup(Tcl_GetString(objv[2]));
862                if (mode_as_char_star == NULL) {
863                        return TCL_ERROR;
864                }
865
866                if (Tcl_GetInt(interp, mode_as_char_star, &mode_as_int) != TCL_OK) {
867                        free(mode_as_char_star);
868                        return TCL_ERROR;
869                }
870                free(mode_as_char_star);
871                mode = (mode_t) mode_as_int;
872        }
873
874        path = strdup(Tcl_GetString(objv[1]));
875        if (path == NULL) {
876                return TCL_ERROR;
877        }
878
879        if (mkfifo(path, mode) != 0) {
880                Tcl_AppendResult(interp, "mkfifo failed: ", strerror(errno), NULL);
881                free(path);
882                return TCL_ERROR;
883        }
884
885        free(path);
886        return TCL_OK;
887}
888
889int ExistsuserCmd(ClientData clientData UNUSED, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
890{
891        Tcl_Obj *tcl_result;
892        struct passwd *pwent;
893        char *user;
894
895        if (objc != 2) {
896                Tcl_WrongNumArgs(interp, 1, objv, "user");
897                return TCL_ERROR;
898        }
899
900        user = strdup(Tcl_GetString(objv[1]));
901        if (isdigit(*(user)))
902                pwent = getpwuid(strtol(user, 0, 0));
903        else
904                pwent = getpwnam(user);
905        free(user);
906
907        if (pwent == NULL)
908                tcl_result = Tcl_NewIntObj(0);
909        else
910                tcl_result = Tcl_NewIntObj(pwent->pw_uid);
911
912        Tcl_SetObjResult(interp, tcl_result);
913        return TCL_OK;
914}
915
916int ExistsgroupCmd(ClientData clientData UNUSED, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
917{
918        Tcl_Obj *tcl_result;
919        struct group *grent;
920        char *group;
921
922        if (objc != 2) {
923                Tcl_WrongNumArgs(interp, 1, objv, "groupname");
924                return TCL_ERROR;
925        }
926
927        group = strdup(Tcl_GetString(objv[1]));
928        if (isdigit(*(group)))
929                grent = getgrgid(strtol(group, 0, 0));
930        else
931                grent = getgrnam(group);
932        free(group);
933
934        if (grent == NULL)
935                tcl_result = Tcl_NewIntObj(0);
936        else
937                tcl_result = Tcl_NewIntObj(grent->gr_gid);
938
939        Tcl_SetObjResult(interp, tcl_result);
940        return TCL_OK;
941}
942
943int NextuidCmd(ClientData clientData UNUSED, Tcl_Interp *interp, int objc UNUSED, Tcl_Obj *CONST objv[] UNUSED)
944{
945        Tcl_Obj *tcl_result;
946        struct passwd *pwent;
947        int max;
948
949        max = 0;
950
951        while ((pwent = getpwent()) != NULL)
952                if ((int)pwent->pw_uid > max)
953                        max = (int)pwent->pw_uid;
954       
955        tcl_result = Tcl_NewIntObj(max + 1);
956        Tcl_SetObjResult(interp, tcl_result);
957        return TCL_OK;
958}
959
960int NextgidCmd(ClientData clientData UNUSED, Tcl_Interp *interp, int objc UNUSED, Tcl_Obj *CONST objv[] UNUSED)
961{
962        Tcl_Obj *tcl_result;
963        struct group *grent;
964        int max;
965
966        max = 0;
967
968        while ((grent = getgrent()) != NULL)
969                if ((int)grent->gr_gid > max)
970                        max = (int)grent->gr_gid;
971       
972        tcl_result = Tcl_NewIntObj(max + 1);
973        Tcl_SetObjResult(interp, tcl_result);
974        return TCL_OK;
975}
976
977int UmaskCmd(ClientData clientData UNUSED, Tcl_Interp *interp, int objc UNUSED, Tcl_Obj *CONST objv[] UNUSED)
978{
979        Tcl_Obj *tcl_result;
980        char *tcl_mask, *p;
981        const size_t stringlen = 4; /* 3 digits & \0 */
982        int i;
983        mode_t *set;
984        mode_t newmode;
985        mode_t oldmode;
986
987        if (objc != 2) {
988                Tcl_WrongNumArgs(interp, 1, objv, "numask");
989                return TCL_ERROR;
990        }
991
992        tcl_mask = Tcl_GetString(objv[1]);
993        if ((set = setmode(tcl_mask)) == NULL) {
994                Tcl_SetResult(interp, "Invalid umask mode", TCL_STATIC);
995                return TCL_ERROR;
996        }
997
998        newmode = getmode(set, 0);
999
1000        oldmode = umask(newmode);
1001
1002        tcl_mask = malloc(stringlen); /* 3 digits & \0 */
1003        if (!tcl_mask) {
1004                return TCL_ERROR;
1005        }
1006
1007        /* Totally gross and cool */
1008        p = tcl_mask + stringlen;
1009        *p = '\0';
1010        for (i = stringlen - 1; i > 0; i--) {
1011                p--;
1012                *p = (oldmode & 7) + '0';
1013                oldmode >>= 3;
1014        }
1015        if (*p != '0') {
1016                p--;
1017                *p = '0';
1018        }
1019
1020        tcl_result = Tcl_NewStringObj(p, -1);
1021        free(tcl_mask);
1022
1023        Tcl_SetObjResult(interp, tcl_result);
1024        return TCL_OK;
1025}
1026
1027/**
1028 * Call pipe(2) to create a pipe.
1029 * Syntax is:
1030 * pipe
1031 *
1032 * Generate a Tcl error if something goes wrong.
1033 * Return a list with the file descriptors of the pipe. The first item is the
1034 * readable fd.
1035 */
1036int PipeCmd(ClientData clientData UNUSED, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
1037{
1038        Tcl_Obj* result;
1039        int fildes[2];
1040
1041        if (objc != 1) {
1042                Tcl_WrongNumArgs(interp, 1, objv, NULL);
1043                return TCL_ERROR;
1044        }
1045       
1046        if (pipe(fildes) < 0) {
1047                Tcl_AppendResult(interp, "pipe failed: ", strerror(errno), NULL);
1048                return TCL_ERROR;
1049        }
1050       
1051        /* build a list out of the couple */
1052        result = Tcl_NewListObj(0, NULL);
1053        Tcl_ListObjAppendElement(interp, result, Tcl_NewIntObj(fildes[0]));
1054        Tcl_ListObjAppendElement(interp, result, Tcl_NewIntObj(fildes[1]));
1055        Tcl_SetObjResult(interp, result);
1056
1057        return TCL_OK;
1058}
1059
1060/**
1061 * Call socketpair to generate a socket pair in the Unix domain.
1062 * Syntax is:
1063 * unixsocketpair
1064 *
1065 * Generate a Tcl error if something goes wrong.
1066 * Return a list with the file descriptors of the pair.
1067 */
1068int UnixSocketPairCmd(ClientData clientData UNUSED, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
1069{
1070        Tcl_Obj* result;
1071        int pair[2];
1072
1073        if (objc != 1) {
1074                Tcl_WrongNumArgs(interp, 1, objv, NULL);
1075                return TCL_ERROR;
1076        }
1077       
1078        if (socketpair(AF_UNIX, SOCK_STREAM, 0, pair) < 0) {
1079                Tcl_AppendResult(interp, "socketpair failed: ", strerror(errno), NULL);
1080                return TCL_ERROR;
1081        }
1082       
1083        /* build a list out of the pair */
1084        result = Tcl_NewListObj(0, NULL);
1085        Tcl_ListObjAppendElement(interp, result, Tcl_NewIntObj(pair[0]));
1086        Tcl_ListObjAppendElement(interp, result, Tcl_NewIntObj(pair[1]));
1087        Tcl_SetObjResult(interp, result);
1088
1089        return TCL_OK;
1090}
1091
1092int Pextlib_Init(Tcl_Interp *interp)
1093{
1094        if (Tcl_InitStubs(interp, "8.3", 0) == NULL)
1095                return TCL_ERROR;
1096
1097        Tcl_CreateObjCommand(interp, "system", SystemCmd, NULL, NULL);
1098        Tcl_CreateObjCommand(interp, "flock", FlockCmd, NULL, NULL);
1099        Tcl_CreateObjCommand(interp, "readdir", ReaddirCmd, NULL, NULL);
1100        Tcl_CreateObjCommand(interp, "strsed", StrsedCmd, NULL, NULL);
1101        Tcl_CreateObjCommand(interp, "mkstemp", MkstempCmd, NULL, NULL);
1102        Tcl_CreateObjCommand(interp, "mktemp", MktempCmd, NULL, NULL);
1103        Tcl_CreateObjCommand(interp, "existsuser", ExistsuserCmd, NULL, NULL);
1104        Tcl_CreateObjCommand(interp, "existsgroup", ExistsgroupCmd, NULL, NULL);
1105        Tcl_CreateObjCommand(interp, "nextuid", NextuidCmd, NULL, NULL);
1106        Tcl_CreateObjCommand(interp, "nextgid", NextgidCmd, NULL, NULL);
1107        Tcl_CreateObjCommand(interp, "md5", MD5Cmd, NULL, NULL);
1108        Tcl_CreateObjCommand(interp, "xinstall", InstallCmd, NULL, NULL);
1109        Tcl_CreateObjCommand(interp, "find", FindCmd, NULL, NULL);
1110        Tcl_CreateObjCommand(interp, "filemap", FilemapCmd, NULL, NULL);
1111        Tcl_CreateObjCommand(interp, "rpm-vercomp", RPMVercompCmd, NULL, NULL);
1112        Tcl_CreateObjCommand(interp, "rmd160", RMD160Cmd, NULL, NULL);
1113        Tcl_CreateObjCommand(interp, "sha1", SHA1Cmd, NULL, NULL);
1114        Tcl_CreateObjCommand(interp, "compat", CompatCmd, NULL, NULL);
1115        Tcl_CreateObjCommand(interp, "umask", UmaskCmd, NULL, NULL);
1116        Tcl_CreateObjCommand(interp, "sudo", SudoCmd, NULL, NULL);
1117        Tcl_CreateObjCommand(interp, "mkfifo", MkfifoCmd, NULL, NULL);
1118        Tcl_CreateObjCommand(interp, "unixsocketpair", UnixSocketPairCmd, NULL, NULL);
1119        Tcl_CreateObjCommand(interp, "mkchannelfromfd", MkChannelFromFdCmd, NULL, NULL);
1120        Tcl_CreateObjCommand(interp, "pipe", PipeCmd, NULL, NULL);
1121        Tcl_CreateObjCommand(interp, "curl", CurlCmd, NULL, NULL);
1122        Tcl_CreateObjCommand(interp, "readline", ReadlineCmd, NULL, NULL);
1123        Tcl_CreateObjCommand(interp, "rl_history", RLHistoryCmd, NULL, NULL);
1124       
1125        if (Tcl_PkgProvide(interp, "Pextlib", "1.0") != TCL_OK)
1126                return TCL_ERROR;
1127
1128        /* init libcurl */
1129        CurlInit(interp);
1130
1131        return TCL_OK;
1132}
Note: See TracBrowser for help on using the repository browser.