Commit | Line | Data |
2986a63f |
1 | /* |
2 | * Copyright © 2001 Novell, Inc. All Rights Reserved. |
3 | * |
4 | * You may distribute under the terms of either the GNU General Public |
5 | * License or the Artistic License, as specified in the README file. |
6 | * |
7 | */ |
8 | |
9 | /* |
10 | * FILENAME : nwperlsys.c |
11 | * DESCRIPTION : Contains the platform specific functions calls |
12 | * |
13 | * Author : SGP |
14 | * Date Created : June 12th 2001. |
15 | * Date Modified: |
16 | */ |
17 | |
18 | #include "EXTERN.h" |
19 | #include "perl.h" |
20 | |
21 | |
22 | #ifdef PERL_OBJECT |
23 | #define NO_XSLOCKS |
24 | #endif |
25 | |
26 | //CHKSGP |
27 | //Including this is giving premature end-of-file error during compilation |
28 | //#include "XSUB.h" |
29 | |
30 | #ifdef PERL_IMPLICIT_SYS |
31 | |
32 | #include "nw5iop.h" |
33 | #include <fcntl.h> |
34 | |
35 | |
36 | #include "win32ish.h" |
37 | |
38 | START_EXTERN_C |
39 | extern int do_spawn2(char *cmd, int exectype); |
40 | extern int do_aspawn(void *vreally, void **vmark, void **vsp); |
41 | extern void Perl_init_os_extras(void); |
42 | extern BOOL fnInsertHashListAddrs(void *addrs, BOOL dontTouchHashList); |
43 | extern BOOL fnGetHashListAddrs(void *addrs, BOOL *dontTouchHashList); |
44 | END_EXTERN_C |
45 | |
46 | //Includes iperlsys.h and function definitions |
47 | #include "nwperlsys.h" |
48 | |
49 | /* IPerlStdio - Stdio functions - Begin ================================================*/ |
50 | |
51 | FILE* |
52 | PerlStdIOStdin(struct IPerlStdIO* piPerl) |
53 | { |
54 | return nw_stdin(); |
55 | } |
56 | |
57 | FILE* |
58 | PerlStdIOStdout(struct IPerlStdIO* piPerl) |
59 | { |
60 | return nw_stdout(); |
61 | } |
62 | |
63 | FILE* |
64 | PerlStdIOStderr(struct IPerlStdIO* piPerl) |
65 | { |
66 | return nw_stderr(); |
67 | } |
68 | |
69 | FILE* |
70 | PerlStdIOOpen(struct IPerlStdIO* piPerl, const char *path, const char *mode) |
71 | { |
72 | return nw_fopen(path, mode); |
73 | } |
74 | |
75 | int |
76 | PerlStdIOClose(struct IPerlStdIO* piPerl, FILE* pf) |
77 | { |
78 | return nw_fclose(pf); |
79 | } |
80 | |
81 | int |
82 | PerlStdIOEof(struct IPerlStdIO* piPerl, FILE* pf) |
83 | { |
84 | return nw_feof(pf); |
85 | } |
86 | |
87 | int |
88 | PerlStdIOError(struct IPerlStdIO* piPerl, FILE* pf) |
89 | { |
90 | return nw_ferror(pf); |
91 | } |
92 | |
93 | void |
94 | PerlStdIOClearerr(struct IPerlStdIO* piPerl, FILE* pf) |
95 | { |
96 | nw_clearerr(pf); |
97 | } |
98 | |
99 | int |
100 | PerlStdIOGetc(struct IPerlStdIO* piPerl, FILE* pf) |
101 | { |
102 | return nw_getc(pf); |
103 | } |
104 | |
105 | char* |
106 | PerlStdIOGetBase(struct IPerlStdIO* piPerl, FILE* pf) |
107 | { |
108 | #ifdef FILE_base |
109 | FILE *f = pf; |
110 | return FILE_base(f); |
111 | #else |
112 | return Nullch; |
113 | #endif |
114 | } |
115 | |
116 | int |
117 | PerlStdIOGetBufsiz(struct IPerlStdIO* piPerl, FILE* pf) |
118 | { |
119 | #ifdef FILE_bufsiz |
120 | FILE *f = pf; |
121 | return FILE_bufsiz(f); |
122 | #else |
123 | return (-1); |
124 | #endif |
125 | } |
126 | |
127 | int |
128 | PerlStdIOGetCnt(struct IPerlStdIO* piPerl, FILE* pf) |
129 | { |
130 | #ifdef USE_STDIO_PTR |
131 | FILE *f = pf; |
132 | return FILE_cnt(f); |
133 | #else |
134 | return (-1); |
135 | #endif |
136 | } |
137 | |
138 | char* |
139 | PerlStdIOGetPtr(struct IPerlStdIO* piPerl, FILE* pf) |
140 | { |
141 | #ifdef USE_STDIO_PTR |
142 | FILE *f = pf; |
143 | return FILE_ptr(f); |
144 | #else |
145 | return Nullch; |
146 | #endif |
147 | } |
148 | |
149 | char* |
150 | PerlStdIOGets(struct IPerlStdIO* piPerl, FILE* pf, char* s, int n) |
151 | { |
152 | return nw_fgets(s, n, pf); |
153 | } |
154 | |
155 | int |
156 | PerlStdIOPutc(struct IPerlStdIO* piPerl, FILE* pf, int c) |
157 | { |
158 | return nw_fputc(c, pf); |
159 | } |
160 | |
161 | int |
162 | PerlStdIOPuts(struct IPerlStdIO* piPerl, FILE* pf, const char *s) |
163 | { |
164 | return nw_fputs(s, pf); |
165 | } |
166 | |
167 | int |
168 | PerlStdIOFlush(struct IPerlStdIO* piPerl, FILE* pf) |
169 | { |
170 | return nw_fflush(pf); |
171 | } |
172 | |
173 | int |
174 | PerlStdIOUngetc(struct IPerlStdIO* piPerl, int c, FILE* pf) |
175 | { |
176 | return nw_ungetc(c, pf); |
177 | } |
178 | |
179 | int |
180 | PerlStdIOFileno(struct IPerlStdIO* piPerl, FILE* pf) |
181 | { |
182 | return nw_fileno(pf); |
183 | } |
184 | |
185 | FILE* |
186 | PerlStdIOFdopen(struct IPerlStdIO* piPerl, int fd, const char *mode) |
187 | { |
188 | return nw_fdopen(fd, mode); |
189 | } |
190 | |
191 | FILE* |
192 | PerlStdIOReopen(struct IPerlStdIO* piPerl, const char*path, const char*mode, FILE* pf) |
193 | { |
194 | return nw_freopen(path, mode, pf); |
195 | } |
196 | |
197 | SSize_t |
198 | PerlStdIORead(struct IPerlStdIO* piPerl, void *buffer, Size_t size, Size_t count, FILE* pf) |
199 | { |
200 | return nw_fread(buffer, size, count, pf); |
201 | } |
202 | |
203 | SSize_t |
204 | PerlStdIOWrite(struct IPerlStdIO* piPerl, const void *buffer, Size_t size, Size_t count, FILE* pf) |
205 | { |
206 | return nw_fwrite(buffer, size, count, pf); |
207 | } |
208 | |
209 | void |
210 | PerlStdIOSetBuf(struct IPerlStdIO* piPerl, FILE* pf, char* buffer) |
211 | { |
212 | nw_setbuf(pf, buffer); |
213 | } |
214 | |
215 | int |
216 | PerlStdIOSetVBuf(struct IPerlStdIO* piPerl, FILE* pf, char* buffer, int type, Size_t size) |
217 | { |
218 | return nw_setvbuf(pf, buffer, type, size); |
219 | } |
220 | |
221 | void |
222 | PerlStdIOSetCnt(struct IPerlStdIO* piPerl, FILE* pf, int n) |
223 | { |
224 | #ifdef STDIO_CNT_LVALUE |
225 | FILE *f = pf; |
226 | FILE_cnt(f) = n; |
227 | #endif |
228 | } |
229 | |
230 | void |
231 | PerlStdIOSetPtr(struct IPerlStdIO* piPerl, FILE* pf, char * ptr) |
232 | { |
233 | #ifdef STDIO_PTR_LVALUE |
234 | FILE *f = pf; |
235 | FILE_ptr(f) = ptr; |
236 | #endif |
237 | } |
238 | |
239 | void |
240 | PerlStdIOSetlinebuf(struct IPerlStdIO* piPerl, FILE* pf) |
241 | { |
242 | nw_setvbuf(pf, NULL, _IOLBF, 0); |
243 | } |
244 | |
245 | int |
246 | PerlStdIOPrintf(struct IPerlStdIO* piPerl, FILE* pf, const char *format,...) |
247 | { |
248 | va_list(arglist); |
249 | va_start(arglist, format); |
250 | return nw_vfprintf(pf, format, arglist); |
251 | } |
252 | |
253 | int |
254 | PerlStdIOVprintf(struct IPerlStdIO* piPerl, FILE* pf, const char *format, va_list arglist) |
255 | { |
256 | return nw_vfprintf(pf, format, arglist); |
257 | } |
258 | |
259 | long |
260 | PerlStdIOTell(struct IPerlStdIO* piPerl, FILE* pf) |
261 | { |
262 | return nw_ftell(pf); |
263 | } |
264 | |
265 | int |
266 | PerlStdIOSeek(struct IPerlStdIO* piPerl, FILE* pf, off_t offset, int origin) |
267 | { |
268 | return nw_fseek(pf, offset, origin); |
269 | } |
270 | |
271 | void |
272 | PerlStdIORewind(struct IPerlStdIO* piPerl, FILE* pf) |
273 | { |
274 | nw_rewind(pf); |
275 | } |
276 | |
277 | FILE* |
278 | PerlStdIOTmpfile(struct IPerlStdIO* piPerl) |
279 | { |
280 | return nw_tmpfile(); |
281 | } |
282 | |
283 | int |
284 | PerlStdIOGetpos(struct IPerlStdIO* piPerl, FILE* pf, Fpos_t *p) |
285 | { |
286 | return nw_fgetpos(pf, p); |
287 | } |
288 | |
289 | int |
290 | PerlStdIOSetpos(struct IPerlStdIO* piPerl, FILE* pf, const Fpos_t *p) |
291 | { |
292 | return nw_fsetpos(pf, p); |
293 | } |
294 | |
295 | void |
296 | PerlStdIOInit(struct IPerlStdIO* piPerl) |
297 | { |
298 | } |
299 | |
300 | void |
301 | PerlStdIOInitOSExtras(struct IPerlStdIO* piPerl) |
302 | { |
303 | Perl_init_os_extras(); |
304 | } |
305 | |
306 | |
307 | int |
308 | PerlStdIOOpenOSfhandle(struct IPerlStdIO* piPerl, long osfhandle, int flags) |
309 | { |
310 | return nw_open_osfhandle(osfhandle, flags); |
311 | } |
312 | |
313 | int |
314 | PerlStdIOGetOSfhandle(struct IPerlStdIO* piPerl, int filenum) |
315 | { |
316 | return nw_get_osfhandle(filenum); |
317 | } |
318 | |
319 | FILE* |
320 | PerlStdIOFdupopen(struct IPerlStdIO* piPerl, FILE* pf) |
321 | { |
322 | FILE* pfdup=NULL; |
323 | fpos_t pos=0; |
324 | char mode[3]={'\0'}; |
325 | int fileno = nw_dup(nw_fileno(pf)); |
326 | |
327 | /* open the file in the same mode */ |
328 | if(((FILE*)pf)->_flag & _IOREAD) { |
329 | mode[0] = 'r'; |
330 | mode[1] = 0; |
331 | } |
332 | else if(((FILE*)pf)->_flag & _IOWRT) { |
333 | mode[0] = 'a'; |
334 | mode[1] = 0; |
335 | } |
336 | else if(((FILE*)pf)->_flag & _IORW) { |
337 | mode[0] = 'r'; |
338 | mode[1] = '+'; |
339 | mode[2] = 0; |
340 | } |
341 | |
342 | /* it appears that the binmode is attached to the |
343 | * file descriptor so binmode files will be handled |
344 | * correctly |
345 | */ |
346 | pfdup = nw_fdopen(fileno, mode); |
347 | |
348 | /* move the file pointer to the same position */ |
349 | if (!fgetpos(pf, &pos)) { |
350 | fsetpos(pfdup, &pos); |
351 | } |
352 | return pfdup; |
353 | } |
354 | |
355 | /* IPerlStdio - Stdio functions - End ================================================*/ |
356 | |
357 | /* IPerlDir - Directory Manipulation functions - Begin ===================================*/ |
358 | |
359 | int |
360 | PerlDirMakedir(struct IPerlDir* piPerl, const char *dirname, int mode) |
361 | { |
362 | return mkdir(dirname); |
363 | } |
364 | |
365 | int |
366 | PerlDirChdir(struct IPerlDir* piPerl, const char *dirname) |
367 | { |
368 | return nw_chdir(dirname); |
369 | } |
370 | |
371 | int |
372 | PerlDirRmdir(struct IPerlDir* piPerl, const char *dirname) |
373 | { |
374 | return nw_rmdir(dirname); |
375 | } |
376 | |
377 | int |
378 | PerlDirClose(struct IPerlDir* piPerl, DIR *dirp) |
379 | { |
380 | return nw_closedir(dirp); |
381 | } |
382 | |
383 | DIR* |
384 | PerlDirOpen(struct IPerlDir* piPerl, char *filename) |
385 | { |
386 | return nw_opendir(filename); |
387 | } |
388 | |
389 | struct direct * |
390 | PerlDirRead(struct IPerlDir* piPerl, DIR *dirp) |
391 | { |
392 | return nw_readdir(dirp); |
393 | } |
394 | |
395 | void |
396 | PerlDirRewind(struct IPerlDir* piPerl, DIR *dirp) |
397 | { |
398 | nw_rewinddir(dirp); |
399 | } |
400 | |
401 | void |
402 | PerlDirSeek(struct IPerlDir* piPerl, DIR *dirp, long loc) |
403 | { |
404 | nw_seekdir(dirp, loc); |
405 | } |
406 | |
407 | long |
408 | PerlDirTell(struct IPerlDir* piPerl, DIR *dirp) |
409 | { |
410 | return nw_telldir(dirp); |
411 | } |
412 | |
413 | /* IPerlDir - Directory Manipulation functions - End ===================================*/ |
414 | |
415 | /* IPerlEnv - Environment related functions - Begin ======================================*/ |
416 | |
417 | char* |
418 | PerlEnvGetenv(struct IPerlEnv* piPerl, const char *varname) |
419 | { |
420 | return(getenv(varname)); |
421 | }; |
422 | |
423 | int |
424 | PerlEnvPutenv(struct IPerlEnv* piPerl, const char *envstring) |
425 | { |
426 | return(putenv(envstring)); |
427 | }; |
428 | |
429 | char* |
430 | PerlEnvGetenv_len(struct IPerlEnv* piPerl, const char* varname, unsigned long* len) |
431 | { |
432 | *len = 0; |
433 | char *e = getenv(varname); |
434 | if (e) |
435 | *len = strlen(e); |
436 | return e; |
437 | } |
438 | |
439 | int |
440 | PerlEnvUname(struct IPerlEnv* piPerl, struct utsname *name) |
441 | { |
442 | return nw_uname(name); |
443 | } |
444 | |
445 | void |
446 | PerlEnvClearenv(struct IPerlEnv* piPerl) |
447 | { |
448 | |
449 | } |
450 | |
451 | /* IPerlEnv - Environment related functions - End ======================================*/ |
452 | |
453 | /* IPerlLIO - Low-level IO functions - Begin =============================================*/ |
454 | |
455 | int |
456 | PerlLIOAccess(struct IPerlLIO* piPerl, const char *path, int mode) |
457 | { |
458 | return nw_access(path, mode); |
459 | } |
460 | |
461 | int |
462 | PerlLIOChmod(struct IPerlLIO* piPerl, const char *filename, int pmode) |
463 | { |
464 | return nw_chmod(filename, pmode); |
465 | } |
466 | |
467 | int |
468 | PerlLIOChown(struct IPerlLIO* piPerl, const char *filename, uid_t owner, gid_t group) |
469 | { |
470 | dTHXo; |
471 | Perl_croak(aTHX_ "chown not implemented!\n"); |
472 | return 0; |
473 | } |
474 | |
475 | int |
476 | PerlLIOChsize(struct IPerlLIO* piPerl, int handle, long size) |
477 | { |
478 | return (nw_chsize(handle,size)); |
479 | } |
480 | |
481 | int |
482 | PerlLIOClose(struct IPerlLIO* piPerl, int handle) |
483 | { |
484 | return nw_close(handle); |
485 | } |
486 | |
487 | int |
488 | PerlLIODup(struct IPerlLIO* piPerl, int handle) |
489 | { |
490 | return nw_dup(handle); |
491 | } |
492 | |
493 | int |
494 | PerlLIODup2(struct IPerlLIO* piPerl, int handle1, int handle2) |
495 | { |
496 | return nw_dup2(handle1, handle2); |
497 | } |
498 | |
499 | int |
500 | PerlLIOFlock(struct IPerlLIO* piPerl, int fd, int oper) |
501 | { |
502 | //On NetWare simulate flock by locking a range on the file |
503 | return nw_flock(fd, oper); |
504 | } |
505 | |
506 | int |
507 | PerlLIOFileStat(struct IPerlLIO* piPerl, int handle, struct stat *buffer) |
508 | { |
509 | return fstat(handle, buffer); |
510 | } |
511 | |
512 | int |
513 | PerlLIOIOCtl(struct IPerlLIO* piPerl, int i, unsigned int u, char *data) |
514 | { |
225a5dca |
515 | return ioctl(i, (int) u, (void *) data); |
2986a63f |
516 | } |
517 | |
518 | int |
519 | PerlLIOIsatty(struct IPerlLIO* piPerl, int fd) |
520 | { |
521 | return nw_isatty(fd); |
522 | } |
523 | |
524 | int |
525 | PerlLIOLink(struct IPerlLIO* piPerl, const char*oldname, const char *newname) |
526 | { |
527 | return nw_link(oldname, newname); |
528 | } |
529 | |
530 | long |
531 | PerlLIOLseek(struct IPerlLIO* piPerl, int handle, long offset, int origin) |
532 | { |
533 | return nw_lseek(handle, offset, origin); |
534 | } |
535 | |
536 | int |
537 | PerlLIOLstat(struct IPerlLIO* piPerl, const char *path, struct stat *buffer) |
538 | { |
539 | return nw_stat(path, buffer); |
540 | } |
541 | |
542 | char* |
543 | PerlLIOMktemp(struct IPerlLIO* piPerl, char *Template) |
544 | { |
545 | return(nw_mktemp(Template)); |
546 | } |
547 | |
548 | int |
549 | PerlLIOOpen(struct IPerlLIO* piPerl, const char *filename, int oflag) |
550 | { |
551 | return nw_open(filename, oflag); |
552 | } |
553 | |
554 | int |
555 | PerlLIOOpen3(struct IPerlLIO* piPerl, const char *filename, int oflag, int pmode) |
556 | { |
557 | return nw_open(filename, oflag, pmode); |
558 | } |
559 | |
560 | int |
561 | PerlLIORead(struct IPerlLIO* piPerl, int handle, void *buffer, unsigned int count) |
562 | { |
563 | return nw_read(handle, buffer, count); |
564 | } |
565 | |
566 | int |
567 | PerlLIORename(struct IPerlLIO* piPerl, const char *OldFileName, const char *newname) |
568 | { |
569 | return nw_rename(OldFileName, newname); |
570 | } |
571 | |
572 | int |
573 | PerlLIOSetmode(struct IPerlLIO* piPerl, FILE *fp, int mode) |
574 | { |
575 | return nw_setmode(fp, mode); |
576 | } |
577 | |
578 | int |
579 | PerlLIONameStat(struct IPerlLIO* piPerl, const char *path, struct stat *buffer) |
580 | { |
581 | return nw_stat(path, buffer); |
582 | } |
583 | |
584 | char* |
585 | PerlLIOTmpnam(struct IPerlLIO* piPerl, char *string) |
586 | { |
587 | return tmpnam(string); |
588 | } |
589 | |
590 | int |
591 | PerlLIOUmask(struct IPerlLIO* piPerl, int pmode) |
592 | { |
593 | return umask(pmode); |
594 | } |
595 | |
596 | int |
597 | PerlLIOUnlink(struct IPerlLIO* piPerl, const char *filename) |
598 | { |
599 | return nw_unlink(filename); |
600 | } |
601 | |
602 | int |
603 | PerlLIOUtime(struct IPerlLIO* piPerl, char *filename, struct utimbuf *times) |
604 | { |
605 | return nw_utime(filename, times); |
606 | } |
607 | |
608 | int |
609 | PerlLIOWrite(struct IPerlLIO* piPerl, int handle, const void *buffer, unsigned int count) |
610 | { |
611 | return nw_write(handle, buffer, count); |
612 | } |
613 | |
614 | /* IPerlLIO - Low-level IO functions - End =============================================*/ |
615 | |
616 | /* IPerlMem - Memory management functions - Begin ========================================*/ |
617 | |
618 | void* |
619 | PerlMemMalloc(struct IPerlMem* piPerl, size_t size) |
620 | { |
621 | void *ptr = NULL; |
622 | ptr = malloc(size); |
623 | if (ptr) { |
624 | void **listptr; |
625 | BOOL m_dontTouchHashLists; |
626 | if(fnGetHashListAddrs(&listptr,&m_dontTouchHashLists)) { |
627 | if (listptr) { |
628 | WCValHashTable<void*>* m_allocList= (WCValHashTable<void*>*)listptr; |
629 | (WCValHashTable<void*>*)m_allocList->insert(ptr); |
630 | } |
631 | } |
632 | } |
633 | return(ptr); |
634 | } |
635 | |
636 | void* |
637 | PerlMemRealloc(struct IPerlMem* piPerl, void* ptr, size_t size) |
638 | { |
639 | void *newptr = NULL; |
640 | WCValHashTable<void*>* m_allocList; |
641 | |
642 | newptr = realloc(ptr, size); |
643 | |
644 | if (ptr) |
645 | { |
646 | void **listptr; |
647 | BOOL m_dontTouchHashLists; |
648 | if(fnGetHashListAddrs(&listptr,&m_dontTouchHashLists)) { |
649 | m_allocList= (WCValHashTable<void*>*)listptr; |
650 | (WCValHashTable<void*>*)m_allocList->remove(ptr); |
651 | } |
652 | } |
653 | if (newptr) |
654 | { |
655 | if (m_allocList) |
656 | (WCValHashTable<void*>*)m_allocList->insert(newptr); |
657 | } |
658 | |
659 | return(newptr); |
660 | } |
661 | |
662 | void |
663 | PerlMemFree(struct IPerlMem* piPerl, void* ptr) |
664 | { |
665 | BOOL m_dontTouchHashLists; |
666 | WCValHashTable<void*>* m_allocList; |
667 | |
668 | void **listptr; |
669 | if(fnGetHashListAddrs(&listptr,&m_dontTouchHashLists)) { |
670 | m_allocList= (WCValHashTable<void*>*)listptr; |
671 | // Final clean up, free all the nodes from the hash list |
672 | if (m_dontTouchHashLists) |
673 | { |
674 | if(ptr) |
675 | { |
676 | free(ptr); |
677 | ptr = NULL; |
678 | } |
679 | } |
680 | else |
681 | { |
682 | if(ptr && m_allocList) |
683 | { |
684 | if ((WCValHashTable<void*>*)m_allocList->remove(ptr)) |
685 | { |
686 | free(ptr); |
687 | ptr = NULL; |
688 | } |
689 | else |
690 | { |
691 | // If it comes here, that means that the memory pointer is not contained in the hash list. |
692 | // But no need to free now, since if is deleted here, it will result in an abend!! |
693 | // If the memory is still there, it will be cleaned during final cleanup anyway. |
694 | } |
695 | } |
696 | } |
697 | } |
698 | return; |
699 | } |
700 | |
701 | void* |
702 | PerlMemCalloc(struct IPerlMem* piPerl, size_t num, size_t size) |
703 | { |
704 | void *ptr = NULL; |
705 | |
706 | ptr = calloc(num, size); |
707 | if (ptr) { |
708 | void **listptr; |
709 | BOOL m_dontTouchHashLists; |
710 | if(fnGetHashListAddrs(&listptr,&m_dontTouchHashLists)) { |
711 | if (listptr) { |
712 | WCValHashTable<void*>* m_allocList= (WCValHashTable<void*>*)listptr; |
713 | (WCValHashTable<void*>*)m_allocList->insert(ptr); |
714 | } |
715 | } |
716 | } |
717 | return(ptr); |
718 | } |
719 | |
720 | /* IPerlMem - Memory management functions - End ========================================*/ |
721 | |
722 | /* IPerlProc - Process control functions - Begin =========================================*/ |
723 | |
724 | #define EXECF_EXEC 1 |
725 | #define EXECF_SPAWN 2 |
726 | |
727 | void |
728 | PerlProcAbort(struct IPerlProc* piPerl) |
729 | { |
730 | nw_abort(); |
731 | } |
732 | |
733 | char * |
734 | PerlProcCrypt(struct IPerlProc* piPerl, const char* clear, const char* salt) |
735 | { |
736 | return nw_crypt(clear, salt); |
737 | } |
738 | |
739 | void |
740 | PerlProcExit(struct IPerlProc* piPerl, int status) |
741 | { |
742 | // exit(status); |
743 | dTHX; |
744 | dJMPENV; |
745 | JMPENV_JUMP(2); |
746 | } |
747 | |
748 | void |
749 | PerlProc_Exit(struct IPerlProc* piPerl, int status) |
750 | { |
751 | // _exit(status); |
752 | dTHX; |
753 | dJMPENV; |
754 | JMPENV_JUMP(2); |
755 | } |
756 | |
757 | int |
758 | PerlProcExecl(struct IPerlProc* piPerl, const char *cmdname, const char *arg0, const char *arg1, const char *arg2, const char *arg3) |
759 | { |
760 | dTHXo; |
761 | Perl_croak(aTHX_ "execl not implemented!\n"); |
762 | return 0; |
763 | } |
764 | |
765 | int |
766 | PerlProcExecv(struct IPerlProc* piPerl, const char *cmdname, const char *const *argv) |
767 | { |
768 | return nw_execvp((char *)cmdname, (char **)argv); |
769 | } |
770 | |
771 | int |
772 | PerlProcExecvp(struct IPerlProc* piPerl, const char *cmdname, const char *const *argv) |
773 | { |
774 | return nw_execvp((char *)cmdname, (char **)argv); |
775 | } |
776 | |
777 | uid_t |
778 | PerlProcGetuid(struct IPerlProc* piPerl) |
779 | { |
780 | return 0; |
781 | } |
782 | |
783 | uid_t |
784 | PerlProcGeteuid(struct IPerlProc* piPerl) |
785 | { |
786 | return 0; |
787 | } |
788 | |
789 | gid_t |
790 | PerlProcGetgid(struct IPerlProc* piPerl) |
791 | { |
792 | return 0; |
793 | } |
794 | |
795 | gid_t |
796 | PerlProcGetegid(struct IPerlProc* piPerl) |
797 | { |
798 | return 0; |
799 | } |
800 | |
801 | char * |
802 | PerlProcGetlogin(struct IPerlProc* piPerl) |
803 | { |
804 | return NULL; |
805 | } |
806 | |
807 | int |
808 | PerlProcKill(struct IPerlProc* piPerl, int pid, int sig) |
809 | { |
810 | return nw_kill(pid, sig); |
811 | } |
812 | |
813 | int |
814 | PerlProcKillpg(struct IPerlProc* piPerl, int pid, int sig) |
815 | { |
816 | dTHXo; |
817 | Perl_croak(aTHX_ "killpg not implemented!\n"); |
818 | return 0; |
819 | } |
820 | |
821 | int |
822 | PerlProcPauseProc(struct IPerlProc* piPerl) |
823 | { |
824 | return nw_sleep((32767L << 16) + 32767); |
825 | } |
826 | |
827 | PerlIO* |
828 | PerlProcPopen(struct IPerlProc* piPerl, const char *command, const char *mode) |
829 | { |
830 | dTHXo; |
831 | PERL_FLUSHALL_FOR_CHILD; |
832 | |
833 | return (PerlIO*)nw_Popen((char *)command, (char *)mode, (int *)errno); |
834 | } |
835 | |
836 | int |
837 | PerlProcPclose(struct IPerlProc* piPerl, PerlIO *stream) |
838 | { |
839 | return nw_Pclose((FILE*)stream, (int *)errno); |
840 | } |
841 | |
842 | int |
843 | PerlProcPipe(struct IPerlProc* piPerl, int *phandles) |
844 | { |
845 | return nw_Pipe((int *)phandles, (int *)errno); |
846 | } |
847 | |
848 | int |
849 | PerlProcSetuid(struct IPerlProc* piPerl, uid_t u) |
850 | { |
851 | return 0; |
852 | } |
853 | |
854 | int |
855 | PerlProcSetgid(struct IPerlProc* piPerl, gid_t g) |
856 | { |
857 | return 0; |
858 | } |
859 | |
860 | int |
861 | PerlProcSleep(struct IPerlProc* piPerl, unsigned int s) |
862 | { |
863 | return nw_sleep(s); |
864 | } |
865 | |
866 | int |
867 | PerlProcTimes(struct IPerlProc* piPerl, struct tms *timebuf) |
868 | { |
869 | return nw_times(timebuf); |
870 | } |
871 | |
872 | int |
873 | PerlProcWait(struct IPerlProc* piPerl, int *status) |
874 | { |
875 | return nw_wait(status); |
876 | } |
877 | |
878 | int |
879 | PerlProcWaitpid(struct IPerlProc* piPerl, int pid, int *status, int flags) |
880 | { |
881 | return nw_waitpid(pid, status, flags); |
882 | } |
883 | |
884 | Sighandler_t |
885 | PerlProcSignal(struct IPerlProc* piPerl, int sig, Sighandler_t subcode) |
886 | { |
887 | return 0; |
888 | } |
889 | |
890 | int |
891 | PerlProcFork(struct IPerlProc* piPerl) |
892 | { |
893 | return 0; |
894 | } |
895 | |
896 | int |
897 | PerlProcGetpid(struct IPerlProc* piPerl) |
898 | { |
899 | return nw_getpid(); |
900 | } |
901 | |
902 | /*BOOL |
903 | PerlProcDoCmd(struct IPerlProc* piPerl, char *cmd) |
904 | { |
905 | do_spawn2(cmd, EXECF_EXEC); |
906 | return FALSE; |
907 | }*/ |
908 | |
909 | int |
910 | PerlProcSpawn(struct IPerlProc* piPerl, char* cmds) |
911 | { |
912 | return do_spawn2(cmds, EXECF_SPAWN); |
913 | } |
914 | |
915 | int |
916 | PerlProcSpawnvp(struct IPerlProc* piPerl, int mode, const char *cmdname, const char *const *argv) |
917 | { |
918 | return nw_spawnvp(mode, (char *)cmdname, (char **)argv); |
919 | } |
920 | |
921 | int |
922 | PerlProcASpawn(struct IPerlProc* piPerl, void *vreally, void **vmark, void **vsp) |
923 | { |
924 | return do_aspawn(vreally, vmark, vsp); |
925 | } |
926 | |
927 | /* IPerlProc - Process control functions - End =========================================*/ |
928 | |
929 | /* IPerlSock - Socket functions - Begin ==================================================*/ |
930 | |
931 | u_long |
932 | PerlSockHtonl(struct IPerlSock* piPerl, u_long hostlong) |
933 | { |
934 | return(nw_htonl(hostlong)); |
935 | } |
936 | |
937 | u_short |
938 | PerlSockHtons(struct IPerlSock* piPerl, u_short hostshort) |
939 | { |
940 | return(nw_htons(hostshort)); |
941 | } |
942 | |
943 | u_long |
944 | PerlSockNtohl(struct IPerlSock* piPerl, u_long netlong) |
945 | { |
946 | return nw_ntohl(netlong); |
947 | } |
948 | |
949 | u_short |
950 | PerlSockNtohs(struct IPerlSock* piPerl, u_short netshort) |
951 | { |
952 | return nw_ntohs(netshort); |
953 | } |
954 | |
955 | SOCKET PerlSockAccept(struct IPerlSock* piPerl, SOCKET s, struct sockaddr* addr, int* addrlen) |
956 | { |
957 | return nw_accept(s, addr, addrlen); |
958 | } |
959 | |
960 | int |
961 | PerlSockBind(struct IPerlSock* piPerl, SOCKET s, const struct sockaddr* name, int namelen) |
962 | { |
963 | return nw_bind(s, name, namelen); |
964 | } |
965 | |
966 | int |
967 | PerlSockConnect(struct IPerlSock* piPerl, SOCKET s, const struct sockaddr* name, int namelen) |
968 | { |
969 | return nw_connect(s, name, namelen); |
970 | } |
971 | |
972 | void |
973 | PerlSockEndhostent(struct IPerlSock* piPerl) |
974 | { |
975 | nw_endhostent(); |
976 | } |
977 | |
978 | void |
979 | PerlSockEndnetent(struct IPerlSock* piPerl) |
980 | { |
981 | nw_endnetent(); |
982 | } |
983 | |
984 | void |
985 | PerlSockEndprotoent(struct IPerlSock* piPerl) |
986 | { |
987 | nw_endprotoent(); |
988 | } |
989 | |
990 | void |
991 | PerlSockEndservent(struct IPerlSock* piPerl) |
992 | { |
993 | nw_endservent(); |
994 | } |
995 | |
996 | struct hostent* |
997 | PerlSockGethostbyaddr(struct IPerlSock* piPerl, const char* addr, int len, int type) |
998 | { |
999 | return(nw_gethostbyaddr(addr,len,type)); |
1000 | } |
1001 | |
1002 | struct hostent* |
1003 | PerlSockGethostbyname(struct IPerlSock* piPerl, const char* name) |
1004 | { |
1005 | return nw_gethostbyname(name); |
1006 | } |
1007 | |
1008 | struct hostent* |
1009 | PerlSockGethostent(struct IPerlSock* piPerl) |
1010 | { |
1011 | return(nw_gethostent()); |
1012 | } |
1013 | |
1014 | int |
1015 | PerlSockGethostname(struct IPerlSock* piPerl, char* name, int namelen) |
1016 | { |
1017 | return nw_gethostname(name,namelen); |
1018 | } |
1019 | |
1020 | struct netent * |
1021 | PerlSockGetnetbyaddr(struct IPerlSock* piPerl, long net, int type) |
1022 | { |
1023 | return nw_getnetbyaddr(net, type); |
1024 | } |
1025 | |
1026 | struct netent * |
1027 | PerlSockGetnetbyname(struct IPerlSock* piPerl, const char *name) |
1028 | { |
1029 | return nw_getnetbyname((char*)name); |
1030 | } |
1031 | |
1032 | struct netent * |
1033 | PerlSockGetnetent(struct IPerlSock* piPerl) |
1034 | { |
1035 | return nw_getnetent(); |
1036 | } |
1037 | |
1038 | int PerlSockGetpeername(struct IPerlSock* piPerl, SOCKET s, struct sockaddr* name, int* namelen) |
1039 | { |
1040 | return nw_getpeername(s, name, namelen); |
1041 | } |
1042 | |
1043 | struct protoent* |
1044 | PerlSockGetprotobyname(struct IPerlSock* piPerl, const char* name) |
1045 | { |
1046 | return nw_getprotobyname(name); |
1047 | } |
1048 | |
1049 | struct protoent* |
1050 | PerlSockGetprotobynumber(struct IPerlSock* piPerl, int number) |
1051 | { |
1052 | return nw_getprotobynumber(number); |
1053 | } |
1054 | |
1055 | struct protoent* |
1056 | PerlSockGetprotoent(struct IPerlSock* piPerl) |
1057 | { |
1058 | return nw_getprotoent(); |
1059 | } |
1060 | |
1061 | struct servent* |
1062 | PerlSockGetservbyname(struct IPerlSock* piPerl, const char* name, const char* proto) |
1063 | { |
1064 | return nw_getservbyname((char*)name, (char*)proto); |
1065 | } |
1066 | |
1067 | struct servent* |
1068 | PerlSockGetservbyport(struct IPerlSock* piPerl, int port, const char* proto) |
1069 | { |
1070 | return nw_getservbyport(port, proto); |
1071 | } |
1072 | |
1073 | struct servent* |
1074 | PerlSockGetservent(struct IPerlSock* piPerl) |
1075 | { |
1076 | return nw_getservent(); |
1077 | } |
1078 | |
1079 | int |
1080 | PerlSockGetsockname(struct IPerlSock* piPerl, SOCKET s, struct sockaddr* name, int* namelen) |
1081 | { |
1082 | return nw_getsockname(s, name, namelen); |
1083 | } |
1084 | |
1085 | int |
1086 | PerlSockGetsockopt(struct IPerlSock* piPerl, SOCKET s, int level, int optname, char* optval, int* optlen) |
1087 | { |
1088 | return nw_getsockopt(s, level, optname, optval, optlen); |
1089 | } |
1090 | |
1091 | unsigned long |
1092 | PerlSockInetAddr(struct IPerlSock* piPerl, const char* cp) |
1093 | { |
1094 | return(nw_inet_addr(cp)); |
1095 | } |
1096 | |
1097 | char* |
1098 | PerlSockInetNtoa(struct IPerlSock* piPerl, struct in_addr in) |
1099 | { |
1100 | return NULL; |
1101 | } |
1102 | |
1103 | int |
1104 | PerlSockListen(struct IPerlSock* piPerl, SOCKET s, int backlog) |
1105 | { |
1106 | return (nw_listen(s, backlog)); |
1107 | } |
1108 | |
1109 | int |
1110 | PerlSockRecv(struct IPerlSock* piPerl, SOCKET s, char* buffer, int len, int flags) |
1111 | { |
1112 | return (nw_recv(s, buffer, len, flags)); |
1113 | } |
1114 | |
1115 | int |
1116 | PerlSockRecvfrom(struct IPerlSock* piPerl, SOCKET s, char* buffer, int len, int flags, struct sockaddr* from, int* fromlen) |
1117 | { |
1118 | return nw_recvfrom(s, buffer, len, flags, from, fromlen); |
1119 | } |
1120 | |
1121 | int |
1122 | PerlSockSelect(struct IPerlSock* piPerl, int nfds, char* readfds, char* writefds, char* exceptfds, const struct timeval* timeout) |
1123 | { |
1124 | return nw_select(nfds, (fd_set*) readfds, (fd_set*) writefds, (fd_set*) exceptfds, timeout); |
1125 | } |
1126 | |
1127 | int |
1128 | PerlSockSend(struct IPerlSock* piPerl, SOCKET s, const char* buffer, int len, int flags) |
1129 | { |
1130 | return (nw_send(s, buffer, len, flags)); |
1131 | } |
1132 | |
1133 | int |
1134 | PerlSockSendto(struct IPerlSock* piPerl, SOCKET s, const char* buffer, int len, int flags, const struct sockaddr* to, int tolen) |
1135 | { |
1136 | return(nw_sendto(s, buffer, len, flags, to, tolen)); |
1137 | } |
1138 | |
1139 | void |
1140 | PerlSockSethostent(struct IPerlSock* piPerl, int stayopen) |
1141 | { |
1142 | nw_sethostent(stayopen); |
1143 | } |
1144 | |
1145 | void |
1146 | PerlSockSetnetent(struct IPerlSock* piPerl, int stayopen) |
1147 | { |
1148 | nw_setnetent(stayopen); |
1149 | } |
1150 | |
1151 | void |
1152 | PerlSockSetprotoent(struct IPerlSock* piPerl, int stayopen) |
1153 | { |
1154 | nw_setprotoent(stayopen); |
1155 | } |
1156 | |
1157 | void |
1158 | PerlSockSetservent(struct IPerlSock* piPerl, int stayopen) |
1159 | { |
1160 | nw_setservent(stayopen); |
1161 | } |
1162 | |
1163 | int |
1164 | PerlSockSetsockopt(struct IPerlSock* piPerl, SOCKET s, int level, int optname, const char* optval, int optlen) |
1165 | { |
225a5dca |
1166 | return nw_setsockopt(s, level, optname, optval, optlen); |
2986a63f |
1167 | } |
1168 | |
1169 | int |
1170 | PerlSockShutdown(struct IPerlSock* piPerl, SOCKET s, int how) |
1171 | { |
1172 | return nw_shutdown(s, how); |
1173 | } |
1174 | |
1175 | SOCKET |
1176 | PerlSockSocket(struct IPerlSock* piPerl, int af, int type, int protocol) |
1177 | { |
1178 | return nw_socket(af, type, protocol); |
1179 | } |
1180 | |
1181 | int |
1182 | PerlSockSocketpair(struct IPerlSock* piPerl, int domain, int type, int protocol, int* fds) |
1183 | { |
1184 | dTHXo; |
1185 | Perl_croak(aTHX_ "socketpair not implemented!\n"); |
1186 | return 0; |
1187 | } |
1188 | |
1189 | int |
1190 | PerlSockIoctlsocket(struct IPerlSock* piPerl, SOCKET s, long cmd, u_long *argp) |
1191 | { |
1192 | dTHXo; |
1193 | Perl_croak(aTHX_ "ioctlsocket not implemented!\n"); |
1194 | return 0; |
1195 | } |
1196 | |
1197 | /* IPerlSock - Socket functions - End ==================================================*/ |
1198 | |
1199 | /*============================================================================================ |
1200 | |
1201 | Function : fnFreeMemEntry |
1202 | |
1203 | Description : Called for each outstanding memory allocation at the end of a script run. |
1204 | Frees the outstanding allocations |
1205 | |
1206 | Parameters : ptr (IN). |
1207 | context (IN) |
1208 | |
1209 | Returns : Nothing. |
1210 | |
1211 | ==============================================================================================*/ |
1212 | |
1213 | void fnFreeMemEntry(void* ptr, void* context) |
1214 | { |
1215 | if(ptr) |
1216 | { |
1217 | PerlMemFree(NULL, ptr); |
1218 | } |
1219 | } |
1220 | /*============================================================================================ |
1221 | |
1222 | Function : fnAllocListHash |
1223 | |
1224 | Description : Hashing function for hash table of memory allocations. |
1225 | |
1226 | Parameters : invalue (IN). |
1227 | |
1228 | Returns : unsigned. |
1229 | |
1230 | ==============================================================================================*/ |
1231 | |
1232 | unsigned fnAllocListHash(void* const& invalue) |
1233 | { |
1234 | return (((unsigned) invalue & 0x0000ff00) >> 8); |
1235 | } |
1236 | |
1237 | /*============================================================================================ |
1238 | |
1239 | Function : perl_alloc |
1240 | |
1241 | Description : creates a Perl interpreter variable and initializes |
1242 | |
1243 | Parameters : none |
1244 | |
1245 | Returns : Pointer to Perl interpreter |
1246 | |
1247 | ==============================================================================================*/ |
1248 | |
1249 | EXTERN_C PerlInterpreter* |
1250 | perl_alloc(void) |
1251 | { |
1252 | PerlInterpreter* my_perl = NULL; |
1253 | |
1254 | WCValHashTable<void*>* m_allocList; |
1255 | m_allocList = new WCValHashTable<void*> (fnAllocListHash, 256); |
1256 | fnInsertHashListAddrs(m_allocList, FALSE); |
1257 | |
1258 | my_perl = perl_alloc_using(&perlMem, |
1259 | NULL, |
1260 | NULL, |
1261 | &perlEnv, |
1262 | &perlStdIO, |
1263 | &perlLIO, |
1264 | &perlDir, |
1265 | &perlSock, |
1266 | &perlProc); |
1267 | if (my_perl) { |
1268 | #ifdef PERL_OBJECT |
1269 | CPerlObj* pPerl = (CPerlObj*)my_perl; |
1270 | #endif |
1271 | //w32_internal_host = m_allocList; |
1272 | } |
1273 | return my_perl; |
1274 | } |
1275 | |
1276 | /*============================================================================================ |
1277 | |
1278 | Function : nw5_delete_internal_host |
1279 | |
1280 | Description : Deletes the alloc_list pointer |
1281 | |
1282 | Parameters : alloc_list pointer |
1283 | |
1284 | Returns : none |
1285 | |
1286 | ==============================================================================================*/ |
1287 | |
1288 | EXTERN_C void |
1289 | nw5_delete_internal_host(void *h) |
1290 | { |
1291 | WCValHashTable<void*>* m_allocList; |
1292 | void **listptr; |
1293 | BOOL m_dontTouchHashLists; |
1294 | if (fnGetHashListAddrs(&listptr,&m_dontTouchHashLists)) { |
1295 | m_allocList = (WCValHashTable<void*>*)listptr; |
1296 | fnInsertHashListAddrs(m_allocList, TRUE); |
1297 | if (m_allocList) |
1298 | { |
1299 | m_allocList->forAll(fnFreeMemEntry, NULL); |
1300 | fnInsertHashListAddrs(NULL, FALSE); |
1301 | delete m_allocList; |
1302 | } |
1303 | } |
1304 | } |
1305 | |
1306 | #endif /* PERL_IMPLICIT_SYS */ |