Commit | Line | Data |
4633a7c4 |
1 | #define INCL_DOS |
2 | #define INCL_NOPM |
7a2f0d5b |
3 | #define INCL_DOSFILEMGR |
c0c09dfd |
4 | #ifndef NO_SYS_ALLOC |
5 | # define INCL_DOSMEMMGR |
6 | # define INCL_DOSERRORS |
7 | #endif /* ! defined NO_SYS_ALLOC */ |
4633a7c4 |
8 | #include <os2.h> |
9 | |
10 | /* |
11 | * Various Unix compatibility functions for OS/2 |
12 | */ |
13 | |
14 | #include <stdio.h> |
15 | #include <errno.h> |
16 | #include <limits.h> |
17 | #include <process.h> |
18 | |
19 | #include "EXTERN.h" |
20 | #include "perl.h" |
21 | |
22 | /*****************************************************************************/ |
23 | /* priorities */ |
24 | |
25 | int setpriority(int which, int pid, int val) |
26 | { |
27 | return DosSetPriority((pid < 0) ? PRTYS_PROCESSTREE : PRTYS_PROCESS, |
28 | val >> 8, val & 0xFF, abs(pid)); |
29 | } |
30 | |
31 | int getpriority(int which /* ignored */, int pid) |
32 | { |
33 | TIB *tib; |
34 | PIB *pib; |
35 | DosGetInfoBlocks(&tib, &pib); |
36 | return tib->tib_ptib2->tib2_ulpri; |
37 | } |
38 | |
39 | /*****************************************************************************/ |
40 | /* spawn */ |
41 | |
42 | static int |
43 | result(int flag, int pid) |
44 | { |
45 | int r, status; |
46 | Signal_t (*ihand)(); /* place to save signal during system() */ |
47 | Signal_t (*qhand)(); /* place to save signal during system() */ |
48 | |
c0c09dfd |
49 | if (pid < 0 || flag != 0) |
4633a7c4 |
50 | return pid; |
51 | |
52 | ihand = signal(SIGINT, SIG_IGN); |
53 | qhand = signal(SIGQUIT, SIG_IGN); |
c0c09dfd |
54 | do { |
55 | r = wait4pid(pid, &status, 0); |
56 | } while (r == -1 && errno == EINTR); |
4633a7c4 |
57 | signal(SIGINT, ihand); |
58 | signal(SIGQUIT, qhand); |
59 | |
60 | statusvalue = (U16)status; |
61 | if (r < 0) |
62 | return -1; |
63 | return status & 0xFFFF; |
64 | } |
65 | |
66 | int |
67 | do_aspawn(really,mark,sp) |
68 | SV *really; |
69 | register SV **mark; |
70 | register SV **sp; |
71 | { |
72 | register char **a; |
73 | char *tmps; |
74 | int rc; |
75 | int flag = P_WAIT, trueflag; |
76 | |
77 | if (sp > mark) { |
78 | New(401,Argv, sp - mark + 1, char*); |
79 | a = Argv; |
80 | |
81 | if (mark < sp && SvIOKp(*(mark+1))) { |
82 | ++mark; |
83 | flag = SvIVx(*mark); |
84 | } |
85 | |
86 | while (++mark <= sp) { |
87 | if (*mark) |
88 | *a++ = SvPVx(*mark, na); |
89 | else |
90 | *a++ = ""; |
91 | } |
92 | *a = Nullch; |
93 | |
94 | trueflag = flag; |
95 | if (flag == P_WAIT) |
96 | flag = P_NOWAIT; |
97 | |
c0c09dfd |
98 | if (*Argv[0] != '/' && *Argv[0] != '\\') /* will swawnvp use PATH? */ |
99 | TAINT_ENV(); /* testing IFS here is overkill, probably */ |
4633a7c4 |
100 | if (really && *(tmps = SvPV(really, na))) |
101 | rc = result(trueflag, spawnvp(flag,tmps,Argv)); |
102 | else |
103 | rc = result(trueflag, spawnvp(flag,Argv[0],Argv)); |
104 | |
105 | if (rc < 0 && dowarn) |
106 | warn("Can't spawn \"%s\": %s", Argv[0], Strerror(errno)); |
c0c09dfd |
107 | if (rc < 0) rc = 255 << 8; /* Emulate the fork(). */ |
4633a7c4 |
108 | } else |
109 | rc = -1; |
110 | do_execfree(); |
111 | return rc; |
112 | } |
113 | |
114 | int |
115 | do_spawn(cmd) |
116 | char *cmd; |
117 | { |
118 | register char **a; |
119 | register char *s; |
120 | char flags[10]; |
121 | char *shell, *copt; |
122 | int rc; |
123 | |
c0c09dfd |
124 | #ifdef TRYSHELL |
125 | if ((shell = getenv("EMXSHELL")) != NULL) |
126 | copt = "-c"; |
127 | else if ((shell = getenv("SHELL")) != NULL) |
4633a7c4 |
128 | copt = "-c"; |
129 | else if ((shell = getenv("COMSPEC")) != NULL) |
130 | copt = "/C"; |
131 | else |
132 | shell = "cmd.exe"; |
c0c09dfd |
133 | #else |
134 | /* Consensus on perl5-porters is that it is _very_ important to |
135 | have a shell which will not change between computers with the |
136 | same architecture, to avoid "action on a distance". |
137 | And to have simple build, this shell should be sh. */ |
138 | shell = "sh.exe"; |
139 | copt = "-c"; |
140 | #endif |
141 | |
142 | while (*cmd && isSPACE(*cmd)) |
143 | cmd++; |
4633a7c4 |
144 | |
145 | /* save an extra exec if possible */ |
146 | /* see if there are shell metacharacters in it */ |
147 | |
c0c09dfd |
148 | if (*cmd == '.' && isSPACE(cmd[1])) |
149 | goto doshell; |
150 | |
151 | if (strnEQ(cmd,"exec",4) && isSPACE(cmd[4])) |
152 | goto doshell; |
153 | |
154 | for (s = cmd; *s && isALPHA(*s); s++) ; /* catch VAR=val gizmo */ |
155 | if (*s == '=') |
156 | goto doshell; |
157 | |
4633a7c4 |
158 | for (s = cmd; *s; s++) { |
c0c09dfd |
159 | if (*s != ' ' && !isALPHA(*s) && strchr("$&*(){}[]'\";\\|?<>~`\n",*s)) { |
4633a7c4 |
160 | if (*s == '\n' && !s[1]) { |
161 | *s = '\0'; |
162 | break; |
163 | } |
c0c09dfd |
164 | doshell: |
165 | rc = result(P_WAIT, |
166 | spawnl(P_NOWAIT,shell,shell,copt,cmd,(char*)0)); |
167 | if (rc < 0 && dowarn) |
168 | warn("Can't spawn \"%s\": %s", shell, Strerror(errno)); |
169 | if (rc < 0) rc = 255 << 8; /* Emulate the fork(). */ |
170 | return rc; |
4633a7c4 |
171 | } |
172 | } |
c0c09dfd |
173 | |
4633a7c4 |
174 | New(402,Argv, (s - cmd) / 2 + 2, char*); |
175 | Cmd = savepvn(cmd, s-cmd); |
176 | a = Argv; |
177 | for (s = Cmd; *s;) { |
178 | while (*s && isSPACE(*s)) s++; |
179 | if (*s) |
180 | *(a++) = s; |
181 | while (*s && !isSPACE(*s)) s++; |
182 | if (*s) |
183 | *s++ = '\0'; |
184 | } |
185 | *a = Nullch; |
186 | if (Argv[0]) { |
187 | rc = result(P_WAIT, spawnvp(P_NOWAIT,Argv[0],Argv)); |
188 | if (rc < 0 && dowarn) |
189 | warn("Can't spawn \"%s\": %s", Argv[0], Strerror(errno)); |
c0c09dfd |
190 | if (rc < 0) rc = 255 << 8; /* Emulate the fork(). */ |
4633a7c4 |
191 | } else |
192 | rc = -1; |
193 | do_execfree(); |
194 | return rc; |
195 | } |
196 | |
c0c09dfd |
197 | FILE * |
198 | my_popen(cmd,mode) |
199 | char *cmd; |
200 | char *mode; |
201 | { |
202 | char *shell = getenv("EMXSHELL"); |
203 | FILE *res; |
204 | |
205 | my_setenv("EMXSHELL", "sh.exe"); |
206 | res = popen(cmd, mode); |
207 | my_setenv("EMXSHELL", shell); |
208 | return res; |
209 | } |
210 | |
4633a7c4 |
211 | /*****************************************************************************/ |
212 | |
213 | #ifndef HAS_FORK |
214 | int |
215 | fork(void) |
216 | { |
217 | die(no_func, "Unsupported function fork"); |
218 | errno = EINVAL; |
219 | return -1; |
220 | } |
221 | #endif |
222 | |
223 | /*****************************************************************************/ |
224 | /* not implemented in EMX 0.9a */ |
225 | |
226 | void * ctermid(x) { return 0; } |
eacfb5f1 |
227 | |
228 | #ifdef MYTTYNAME /* was not in emx0.9a */ |
4633a7c4 |
229 | void * ttyname(x) { return 0; } |
eacfb5f1 |
230 | #endif |
4633a7c4 |
231 | |
232 | void * gethostent() { return 0; } |
233 | void * getnetent() { return 0; } |
234 | void * getprotoent() { return 0; } |
235 | void * getservent() { return 0; } |
236 | void sethostent(x) {} |
237 | void setnetent(x) {} |
238 | void setprotoent(x) {} |
239 | void setservent(x) {} |
240 | void endhostent(x) {} |
241 | void endnetent(x) {} |
242 | void endprotoent(x) {} |
243 | void endservent(x) {} |
244 | |
245 | /*****************************************************************************/ |
246 | /* stat() hack for char/block device */ |
247 | |
248 | #if OS2_STAT_HACK |
249 | |
250 | /* First attempt used DosQueryFSAttach which crashed the system when |
251 | used with 5.001. Now just look for /dev/. */ |
252 | |
253 | int |
254 | os2_stat(char *name, struct stat *st) |
255 | { |
256 | static int ino = SHRT_MAX; |
257 | |
258 | if (stricmp(name, "/dev/con") != 0 |
259 | && stricmp(name, "/dev/tty") != 0) |
260 | return stat(name, st); |
261 | |
262 | memset(st, 0, sizeof *st); |
263 | st->st_mode = S_IFCHR|0666; |
264 | st->st_ino = (ino-- & 0x7FFF); |
265 | st->st_nlink = 1; |
266 | return 0; |
267 | } |
268 | |
269 | #endif |
c0c09dfd |
270 | |
271 | #ifndef NO_SYS_ALLOC |
272 | |
7a2f0d5b |
273 | static char *oldchunk; |
274 | static long oldsize; |
c0c09dfd |
275 | |
7a2f0d5b |
276 | #define _32_K (1<<15) |
277 | #define _64_K (1<<16) |
c0c09dfd |
278 | |
7a2f0d5b |
279 | /* The real problem is that DosAllocMem will grant memory on 64K-chunks |
280 | * boundaries only. Note that addressable space for application memory |
281 | * is around 240M, thus we will run out of addressable space if we |
282 | * allocate around 14M worth of 4K segments. |
283 | * Thus we allocate memory in 64K chunks, and abandon the rest of the old |
284 | * chunk if the new is bigger than that rest. Also, we just allocate |
285 | * whatever is requested if the size is bigger that 32K. With this strategy |
286 | * we cannot lose more than 1/2 of addressable space. */ |
c0c09dfd |
287 | |
288 | void * |
289 | sbrk(int size) |
290 | { |
291 | char *got; |
292 | APIRET rc; |
7a2f0d5b |
293 | int small, reqsize; |
c0c09dfd |
294 | |
295 | if (!size) return 0; |
7a2f0d5b |
296 | else if (size <= oldsize) { |
297 | got = oldchunk; |
298 | oldchunk += size; |
299 | oldsize -= size; |
300 | return (void *)got; |
301 | } else if (size >= _32_K) { |
302 | small = 0; |
303 | } else { |
304 | reqsize = size; |
305 | size = _64_K; |
306 | small = 1; |
c0c09dfd |
307 | } |
308 | rc = DosAllocMem((void **)&got, size, PAG_COMMIT | PAG_WRITE); |
309 | if (rc == ERROR_NOT_ENOUGH_MEMORY) { |
310 | return (void *) -1; |
311 | } else if ( rc ) die("Got an error from DosAllocMem: %li", (long)rc); |
7a2f0d5b |
312 | if (small) { |
313 | /* Chunk is small, register the rest for future allocs. */ |
314 | oldchunk = got + reqsize; |
315 | oldsize = size - reqsize; |
316 | } |
c0c09dfd |
317 | return (void *)got; |
318 | } |
319 | #endif /* ! defined NO_SYS_ALLOC */ |
320 | |
321 | /* tmp path */ |
322 | |
323 | char *tmppath = TMPPATH1; |
324 | |
325 | void |
326 | settmppath() |
327 | { |
328 | char *p = getenv("TMP"), *tpath; |
329 | int len; |
330 | |
331 | if (!p) p = getenv("TEMP"); |
332 | if (!p) return; |
333 | len = strlen(p); |
334 | tpath = (char *)malloc(len + strlen(TMPPATH1) + 2); |
335 | strcpy(tpath, p); |
336 | tpath[len] = '/'; |
337 | strcpy(tpath + len + 1, TMPPATH1); |
338 | tmppath = tpath; |
339 | } |
7a2f0d5b |
340 | |
341 | #include "XSUB.h" |
342 | |
343 | XS(XS_File__Copy_syscopy) |
344 | { |
345 | dXSARGS; |
346 | if (items < 2 || items > 3) |
347 | croak("Usage: File::Copy::syscopy(src,dst,flag=0)"); |
348 | { |
349 | char * src = (char *)SvPV(ST(0),na); |
350 | char * dst = (char *)SvPV(ST(1),na); |
351 | U32 flag; |
352 | int RETVAL, rc; |
353 | |
354 | if (items < 3) |
355 | flag = 0; |
356 | else { |
357 | flag = (unsigned long)SvIV(ST(2)); |
358 | } |
359 | |
360 | errno = DosCopy(src, dst, flag); |
361 | RETVAL = !errno; |
362 | ST(0) = sv_newmortal(); |
363 | sv_setiv(ST(0), (IV)RETVAL); |
364 | } |
365 | XSRETURN(1); |
366 | } |
367 | |
368 | OS2_Perl_data_t OS2_Perl_data; |
369 | |
370 | int |
371 | Xs_OS2_init() |
372 | { |
373 | char *file = __FILE__; |
374 | { |
375 | newXS("File::Copy::syscopy", XS_File__Copy_syscopy, file); |
376 | } |
377 | } |
378 | |
379 | void |
380 | Perl_OS2_init() |
381 | { |
382 | settmppath(); |
383 | OS2_Perl_data.xs_init = &Xs_OS2_init; |
384 | } |