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