[Tkabber-dev] [tclgpg commit] r34 - trunk

codesite-noreply at google.com codesite-noreply at google.com
Tue Nov 18 21:31:30 MSK 2008


Author: sgolovan
Date: Tue Nov 18 10:30:36 2008
New Revision: 34

Added:
    trunk/Makefile   (contents, props changed)
    trunk/tclgpg.c   (contents, props changed)
Modified:
    trunk/ChangeLog
    trunk/tclgpg.tcl

Log:
	* tclgpg.c, tclgpg.tcl, Makefile: Added a wrapper around gpg call
	  to make use of pipes (and therefore of TclX or Tcl 8.6) and use
	  of temporary files unnecessary. (Unfinished yet, some resources
	  cleanup and porting to Windows is needed).


Modified: trunk/ChangeLog
==============================================================================
--- trunk/ChangeLog	(original)
+++ trunk/ChangeLog	Tue Nov 18 10:30:36 2008
@@ -1,3 +1,10 @@
+2008-11-18  Sergei Golovan  <sgolovan at nes.ru>
+
+	* tclgpg.c, tclgpg.tcl, Makefile: Added a wrapper around gpg call
+	  to make use of pipes (and therefore of TclX or Tcl 8.6) and use
+	  of temporary files unnecessary. (Unfinished yet, some resources
+	  cleanup and porting to Windows is needed).
+
  2008-10-28  Sergei Golovan  <sgolovan at nes.ru>

  	* tclgpg.tcl: Made the first gpg call use auto_execok.

Added: trunk/Makefile
==============================================================================
--- (empty file)
+++ trunk/Makefile	Tue Nov 18 10:30:36 2008
@@ -0,0 +1,6 @@
+tclgpg.so: tclgpg.o
+	gcc -shared -o tclgpg.so tclgpg.o -L/usr/lib -ltclstub8.4
+
+tclgpg.o: tclgpg.c
+	gcc -I/usr/include/tcl -o tclgpg.o -c tclgpg.c
+

Added: trunk/tclgpg.c
==============================================================================
--- (empty file)
+++ trunk/tclgpg.c	Tue Nov 18 10:30:36 2008
@@ -0,0 +1,279 @@
+/* tclgpgme.c --
+ *      Tcl interface to GNU Privacy Guard -- wrapper around gpg call.
+ *
+ * Copyright (c) 2008 Sergei Golovan <sgolovan at nes.ru>,
+ *                    Antoni Grzymala <antoni at chopin.edu.pl>
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAMER OF ALL WARRANTIES.
+ *
+ * $Id$
+ */
+
+#include <tcl.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <unistd.h>
+#include <sys/types.h>
+#include <sys/wait.h>
+
+#define MAXCNAME 32
+
+/* CloseDup --
+ *
+ *      Close one file handler and duplicate the other one.
+ *
+ * Arguments:
+ *      cpipe       file descriptor to close;
+ *      dpipe       file descriptor to duplicate;
+ *      fd          if -1 then don't duplicate the second descriptor,
+ *                  otherwise duplicate it to fd number.
+ *
+ * Result:
+ *      None.
+ *
+ * Side effects:
+ *      In case of error the process is terminated.
+ */
+
+void CloseDup(int cpipe,
+              int dpipe,
+              int fd) {
+    close(cpipe);
+    if (fd >= 0) {
+        close(fd);
+        if (dup2(dpipe, fd) < 0) _exit(1);
+    }
+}
+
+/* CloseAndCreateChan --
+ *
+ *      Close one file handler and create a Tcl channel for the other one.
+ *
+ * Arguments:
+ *      interp      a pointer to Tcl interpreter;
+ *      cpipe       file descriptor to close;
+ *      dpipe       file descriptor to wrap a Tcl channel around it;
+ *      readOrWrite either TCL_READABLE or TCL_WRITABLE.
+ *
+ * Result:
+ *      A pointer to a string object with new created Tcl channel name.
+ *
+ * Side effects:
+ *      A new Tcl channel is created.
+ */
+
+Tcl_Obj *CloseAndCreateChan(Tcl_Interp *interp,
+                            int cpipe,
+                            int dpipe,
+                            int readOrWrite) {
+        Tcl_Channel chan;
+
+        close(cpipe);
+        chan = Tcl_MakeFileChannel((ClientData) dpipe, readOrWrite);
+        Tcl_RegisterChannel(interp, chan);
+        return Tcl_NewStringObj(Tcl_GetChannelName(chan),-1);
+}
+
+/* Gpg_Exec --
+ *
+ *        Spawn GPG process and prepare several Tcl channels for  
communication.
+ *
+ * Arguments:
+ *      unused      unused client data;
+ *      interp      a pointer to Tcl interpreter;
+ *      objc        a number of arguments;
+ *      objv        a pointer to a table of arguments.
+ *
+ * Result:
+ *      Either TCL_OK or TCL_ERROR. Tcl result is set to a list of opened
+ *      channels in case of success.
+ *
+ * Side effects:
+ *      A GPG process is spawned and 4 or 5 pipes are opened to it.
+ */
+
+static int Gpg_Exec(ClientData  unused,
+                    Tcl_Interp *interp,
+                    int         objc,
+                    Tcl_Obj    *CONST objv[]) {
+    char *executable;
+    int status;
+    pid_t pid;
+    int inpipe[2], outpipe[2], errpipe[2], stspipe[2], cmdpipe[2],  
msgpipe[2];
+    Tcl_Obj *resultPtr;
+    int argc, i, decrypt, verify, batch;
+    char **argv, **argv1;
+    char stsChannelName[MAXCNAME], cmdChannelName[MAXCNAME],  
msgChannelName[MAXCNAME];
+
+    Tcl_ResetResult(interp);
+
+    if (objc == 1) {
+        Tcl_AppendResult (interp, "usage: ", Tcl_GetString(objv[0]),
+                                  " executable ?args?", NULL);
+        return TCL_ERROR;
+    } else {
+        Tcl_AppendResult(interp, Tcl_GetString(objv[0]), ": ", NULL);
+
+        pipe(inpipe);
+        pipe(outpipe);
+        pipe(errpipe);
+        pipe(stspipe);
+
+        executable = Tcl_GetString(objv[1]);
+
+        argv = (char **) ckalloc((objc + 16) * sizeof(char *));
+
+        argc = 2;
+        argv1 = argv + 2;
+
+        argv[argc++] = executable;
+        argv[argc++] = "--status-fd";
+        sprintf(stsChannelName, "%d", stspipe[1]);
+        argv[argc++] = stsChannelName;
+        argv[argc++] = "--enable-special-filenames";
+
+        decrypt = 0;
+        verify = 0;
+        batch = 0;
+
+        for (i = 2; i < objc; i++) {
+            argv[argc] = Tcl_GetString(objv[i]);
+
+            if (strcmp(argv[argc], "--decrypt") == 0) {
+                decrypt = 1;
+            } else if (strcmp(argv[argc], "--verify") == 0) {
+                verify = 1;
+            } else if (strcmp(argv[argc], "--batch") == 0) {
+                batch = 1;
+            }
+
+            argc++;
+        }
+
+        if (!batch) {
+            pipe(cmdpipe);
+            argv[0] = executable;
+            argv[1] = "--command-fd";
+            sprintf(cmdChannelName, "%d", cmdpipe[0]);
+            argv[2] = cmdChannelName;
+            argv1 = argv;
+        }
+
+        if (decrypt || verify) {
+            pipe(msgpipe);
+            sprintf(msgChannelName, "-&%d", msgpipe[0]);
+            argv[argc++] = msgChannelName;
+        }
+
+        if (verify) {
+            argv[argc++] = "-";
+        }
+
+        argv[argc++] = NULL;
+
+        if ((pid = fork()) < 0) {
+            Tcl_AppendResult (interp, "can't fork", NULL);
+            return TCL_ERROR;
+        }
+
+        if (pid == 0) {
+            /* child: another fork and exit */
+
+            if ((pid = fork()) < 0)
+                _exit(1);
+            else if (pid > 0)
+                _exit(0);
+
+            /* grandchild */
+
+            CloseDup(inpipe[1], inpipe[0], 0);
+            CloseDup(outpipe[0], outpipe[1], 1);
+            CloseDup(errpipe[0], errpipe[1], 2);
+            close(stspipe[0]);
+            if (!batch) {
+                close(cmdpipe[1]);
+            }
+            if (decrypt || verify) {
+                close(msgpipe[1]);
+            }
+
+            execv(executable, argv1);
+
+            _exit(1);
+        }
+
+        if (waitpid(pid, &status, 0) < 0) {
+            Tcl_AppendResult (interp, "can't waitpid", NULL);
+            return TCL_ERROR;
+        }
+
+        if (WIFSIGNALED(status)) {
+            Tcl_AppendResult (interp, "child is terminated by a signal",  
NULL);
+            return TCL_ERROR;
+        } else if (WIFEXITED(status)) {
+            if (WEXITSTATUS(status)) {
+                Tcl_AppendResult (interp, "child is exited with nonzero  
code", NULL);
+                return TCL_ERROR;
+            }
+        } else {
+            Tcl_AppendResult (interp, "child is exited abnormally", NULL);
+            return TCL_ERROR;
+        }
+
+        resultPtr = Tcl_NewObj();
+
+        Tcl_ListObjAppendElement(NULL, resultPtr,
+                                 CloseAndCreateChan(interp, inpipe[0],
+                                                    inpipe[1],  
TCL_WRITABLE));
+        Tcl_ListObjAppendElement(NULL, resultPtr,
+                                 CloseAndCreateChan(interp, outpipe[1],
+                                                    outpipe[0],  
TCL_READABLE));
+        Tcl_ListObjAppendElement(NULL, resultPtr,
+                                 CloseAndCreateChan(interp, errpipe[1],
+                                                    errpipe[0],  
TCL_READABLE));
+        Tcl_ListObjAppendElement(NULL, resultPtr,
+                                 CloseAndCreateChan(interp, stspipe[1],
+                                                    stspipe[0],  
TCL_READABLE));
+        if (!batch) {
+            Tcl_ListObjAppendElement(NULL, resultPtr,
+                                     CloseAndCreateChan(interp, cmdpipe[0],
+                                                        cmdpipe[1],  
TCL_WRITABLE));
+        }
+        if (decrypt || verify) {
+            Tcl_ListObjAppendElement(NULL, resultPtr,
+                                     CloseAndCreateChan(interp, msgpipe[0],
+                                                        msgpipe[1],  
TCL_WRITABLE));
+        }
+        Tcl_SetObjResult(interp, resultPtr);
+        return TCL_OK;
+    }
+}
+
+/* Tclgpg_Init --
+ *
+ *      Initialize the library and register ::gpg::CExecGPG command.
+ *
+ * Arguments:
+ *      interp      a pointer to Tcl interpreter.
+ *
+ * Result:
+ *      TCL_OK in case of success or TCL_ERROR in case of failure.
+ *
+ * Side effects:
+ *      A new Tcl command is created.
+ */
+
+int Tclgpg_Init (Tcl_Interp *interp) {
+    if (Tcl_InitStubs (interp, "8.0", 0) == NULL)
+        return TCL_ERROR;
+
+    Tcl_CreateObjCommand (interp, "::gpg::CExecGPG", &Gpg_Exec,
+                          (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
+
+    return TCL_OK;
+}
+
+/*
+ * vim:ts=8:sw=4:sts=4:et
+ */

Modified: trunk/tclgpg.tcl
==============================================================================
--- trunk/tclgpg.tcl	(original)
+++ trunk/tclgpg.tcl	Tue Nov 18 10:30:36 2008
@@ -11,10 +11,13 @@

  package require Tcl 8.4

-if {[package vsatisfies $::tcl_version 8.6]} {
-    interp alias {} pipe {} chan pipe
-} elseif {[catch {package require pipe}]} {
-    package require Tclx
+if {[catch {load [file join [file dirname [info script]] \
+			    tclgpg[info sharedlibextension]]} res]} {
+    if {[package vsatisfies $::tcl_version 8.6]} {
+	interp alias {} pipe {} chan pipe
+    } elseif {[catch {package require pipe}]} {
+	package require Tclx
+    }
  }

  if {[llength [auto_execok gpg]] == 0 || \
@@ -1189,6 +1192,10 @@
  proc ::gpg::ExecGPG {token args} {
      Debug 1 $args

+    # Add common --no-tty, --quiet, --output -, --charset utf-8 arguments
+
+    set args [linsert $args 0 --no-tty --quiet --output - --charset utf-8]
+
      # Set --textmode option before calling CExecGPG to make it simpler.

      set textmode [Get $token -property textmode]
@@ -1201,7 +1208,7 @@
          set args [linsert $args 0 --no-textmode]
      }

-    if {[::info proc [namespace current]::CExecGPG] ne ""} {
+    if {[::info commands [namespace current]::CExecGPG] ne ""} {

          # C-based GPG invocation will use pipes instead of temporary files,
          # so in case of decryption or verification of a detached signature
@@ -1284,16 +1291,16 @@
          set args [linsert $args end -]
      }

-    # Add common --no-tty, --quiet, --output -, --status-fd arguments, and
+    # Add common --status-fd argument, and
      # --command-fd if there's no --batch option

-    set args [linsert $args 0 --no-tty --quiet --output - --charset utf-8  
--status-fd 2]
+    set args [linsert $args 0 --status-fd 2]

      if {[lsearch -exact $args --batch] < 0} {
          set args [linsert $args 0 --command-fd 0]
-        set command 1
+        set batch 0
      } else {
-        set command 0
+        set batch 1
      }

      set pList [pipe]
@@ -1314,7 +1321,7 @@
      close $pWrite
      close $qWrite

-    if {$command} {
+    if {!$batch} {
          # Return channels in order: temporary file name, stdin, stdout,
          # stderr, status-fd, command-fd

@@ -1410,6 +1417,7 @@
                      puts $command_fd \
                           [eval $pcb [list [list token $token \
                                                  description $desc]]]
+		    flush $command_fd
                  }
              }
              NEED_PASSPHRASE_SYM {
@@ -1422,6 +1430,7 @@
                      puts $command_fd \
                           [eval $pcb [list [list token $token \
                                                  description ENTER]]]
+		    flush $command_fd
                  }
              }
              KEYEXPIRED {


More information about the Tkabber-dev mailing list