gnu/usr.bin/perl/perl/usersub.c

   1 /* $RCSfile: usersub.c,v $$Revision: 1.1.1.1 $$Date: 1994/09/10 06:27:34 $
   2  *
   3  *  This file contains stubs for routines that the user may define to
   4  *  set up glue routines for C libraries or to decrypt encrypted scripts
   5  *  for execution.
   6  *
   7  * $Log: usersub.c,v $
   8  * Revision 1.1.1.1  1994/09/10  06:27:34  gclarkii
   9  * Initial import of Perl 4.046 bmaked
  10  *
  11  * Revision 1.1.1.1  1993/08/23  21:29:40  nate
  12  * PERL!
  13  *
  14  * Revision 4.0.1.2  92/06/08  16:04:24  lwall
  15  * patch20: removed implicit int declarations on functions
  16  *
  17  * Revision 4.0.1.1  91/11/11  16:47:17  lwall
  18  * patch19: deleted some unused functions from usersub.c
  19  *
  20  * Revision 4.0  91/03/20  01:55:56  lwall
  21  * 4.0 baseline.
  22  *
  23  */
  24
  25 #include "EXTERN.h"
  26 #include "perl.h"
  27
  28 int
  29 userinit()
  30 {
  31     return 0;
  32 }
  33
  34 /*
  35  * The following is supplied by John Macdonald as a means of decrypting
  36  * and executing (presumably proprietary) scripts that have been encrypted
  37  * by a (presumably secret) method.  The idea is that you supply your own
  38  * routine in place of cryptfilter (which is purposefully a very weak
  39  * encryption).  If an encrypted script is detected, a process is forked
  40  * off to run the cryptfilter routine as input to perl.
  41  */
  42
  43 #ifdef CRYPTSCRIPT
  44
  45 #include <signal.h>
  46 #ifdef I_VFORK
  47 #include <vfork.h>
  48 #endif
  49
  50 #ifdef CRYPTLOCAL
  51
  52 #include "cryptlocal.h"
  53
  54 #else   /* ndef CRYPTLOCAL */
  55
  56 #define CRYPT_MAGIC_1   0xfb
  57 #define CRYPT_MAGIC_2   0xf1
  58
  59 void
  60 cryptfilter( fil )
  61 FILE *  fil;
  62 {
  63     int    ch;
  64
  65     while( (ch = getc( fil )) != EOF ) {
  66         putchar( (ch ^ 0x80) );
  67     }
  68 }
  69
  70 #endif  /* CRYPTLOCAL */
  71
  72 #ifndef MSDOS
  73 static FILE     *lastpipefile;
  74 static int      pipepid;
  75
  76 #ifdef VOIDSIG
  77 #  define       VOID    void
  78 #else
  79 #  define       VOID    int
  80 #endif
  81
  82 FILE *
  83 mypfiopen(fil,func)             /* open a pipe to function call for input */
  84 FILE    *fil;
  85 VOID    (*func)();
  86 {
  87     int p[2];
  88     STR *str;
  89
  90     if (pipe(p) < 0) {
  91         fclose( fil );
  92         fatal("Can't get pipe for decrypt");
  93     }
  94
  95     /* make sure that the child doesn't get anything extra */
  96     fflush(stdout);
  97     fflush(stderr);
  98
  99     while ((pipepid = fork()) < 0) {
 100         if (errno != EAGAIN) {
 101             close(p[0]);
 102             close(p[1]);
 103             fclose( fil );
 104             fatal("Can't fork for decrypt");
 105         }
 106         sleep(5);
 107     }
 108     if (pipepid == 0) {
 109         close(p[0]);
 110         if (p[1] != 1) {
 111             dup2(p[1], 1);
 112             close(p[1]);
 113         }
 114         (*func)(fil);
 115         fflush(stdout);
 116         fflush(stderr);
 117         _exit(0);
 118     }
 119     close(p[1]);
 120     close(fileno(fil));
 121     fclose(fil);
 122     str = afetch(fdpid,p[0],TRUE);
 123     str->str_u.str_useful = pipepid;
 124     return fdopen(p[0], "r");
 125 }
 126
 127 void
 128 cryptswitch()
 129 {
 130     int ch;
 131 #ifdef STDSTDIO
 132     /* cheat on stdio if possible */
 133     if (rsfp->_cnt > 0 && (*rsfp->_ptr & 0xff) != CRYPT_MAGIC_1)
 134         return;
 135 #endif
 136     ch = getc(rsfp);
 137     if (ch == CRYPT_MAGIC_1) {
 138         if (getc(rsfp) == CRYPT_MAGIC_2) {
 139             if( perldb ) fatal("can't debug an encrypted script");
 140             rsfp = mypfiopen( rsfp, cryptfilter );
 141             preprocess = 1;     /* force call to pclose when done */
 142         }
 143         else
 144             fatal( "bad encryption format" );
 145     }
 146     else
 147         ungetc(ch,rsfp);
 148 }
 149 #endif /* !MSDOS */
 150
 151 #endif /* CRYPTSCRIPT */