This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Win32: add lstat(), fetch st_dev and st_ino and fetch st_nlink for fstat
[perl5.git] / win32 / perlhost.h
CommitLineData
7766f137
GS
1/* perlhost.h
2 *
f3dccfae 3 * (c) 1999 Microsoft Corporation. All rights reserved.
7766f137
GS
4 * Portions (c) 1999 ActiveState Tool Corp, http://www.ActiveState.com/
5 *
6 * You may distribute under the terms of either the GNU General Public
7 * License or the Artistic License, as specified in the README file.
8 */
9
222c300a
NIS
10#define CHECK_HOST_INTERP
11
7766f137
GS
12#ifndef ___PerlHost_H___
13#define ___PerlHost_H___
14
71d280e3 15#include <signal.h>
81a306d4 16#include <wchar.h>
7766f137
GS
17#include "iperlsys.h"
18#include "vmem.h"
19#include "vdir.h"
20
d684b162
JD
21#ifndef WC_NO_BEST_FIT_CHARS
22# define WC_NO_BEST_FIT_CHARS 0x00000400
23#endif
24
7766f137 25START_EXTERN_C
73f2c082 26extern char * g_getlogin(void);
7766f137 27END_EXTERN_C
7766f137
GS
28
29class CPerlHost
30{
31public:
5f1a76d0 32 /* Constructors */
7766f137
GS
33 CPerlHost(void);
34 CPerlHost(struct IPerlMem** ppMem, struct IPerlMem** ppMemShared,
35 struct IPerlMem** ppMemParse, struct IPerlEnv** ppEnv,
36 struct IPerlStdIO** ppStdIO, struct IPerlLIO** ppLIO,
37 struct IPerlDir** ppDir, struct IPerlSock** ppSock,
38 struct IPerlProc** ppProc);
39 CPerlHost(CPerlHost& host);
40 ~CPerlHost(void);
41
42 static CPerlHost* IPerlMem2Host(struct IPerlMem* piPerl);
43 static CPerlHost* IPerlMemShared2Host(struct IPerlMem* piPerl);
44 static CPerlHost* IPerlMemParse2Host(struct IPerlMem* piPerl);
45 static CPerlHost* IPerlEnv2Host(struct IPerlEnv* piPerl);
46 static CPerlHost* IPerlStdIO2Host(struct IPerlStdIO* piPerl);
47 static CPerlHost* IPerlLIO2Host(struct IPerlLIO* piPerl);
48 static CPerlHost* IPerlDir2Host(struct IPerlDir* piPerl);
49 static CPerlHost* IPerlSock2Host(struct IPerlSock* piPerl);
50 static CPerlHost* IPerlProc2Host(struct IPerlProc* piPerl);
51
52 BOOL PerlCreate(void);
53 int PerlParse(int argc, char** argv, char** env);
54 int PerlRun(void);
55 void PerlDestroy(void);
56
57/* IPerlMem */
f3dccfae 58 /* Locks provided but should be unnecessary as this is private pool */
7766f137
GS
59 inline void* Malloc(size_t size) { return m_pVMem->Malloc(size); };
60 inline void* Realloc(void* ptr, size_t size) { return m_pVMem->Realloc(ptr, size); };
61 inline void Free(void* ptr) { m_pVMem->Free(ptr); };
62 inline void* Calloc(size_t num, size_t size)
63 {
64 size_t count = num*size;
65 void* lpVoid = Malloc(count);
66 if (lpVoid)
67 ZeroMemory(lpVoid, count);
68 return lpVoid;
69 };
70 inline void GetLock(void) { m_pVMem->GetLock(); };
71 inline void FreeLock(void) { m_pVMem->FreeLock(); };
72 inline int IsLocked(void) { return m_pVMem->IsLocked(); };
73
74/* IPerlMemShared */
f3dccfae
NIS
75 /* Locks used to serialize access to the pool */
76 inline void GetLockShared(void) { m_pVMemShared->GetLock(); };
77 inline void FreeLockShared(void) { m_pVMemShared->FreeLock(); };
78 inline int IsLockedShared(void) { return m_pVMemShared->IsLocked(); };
7766f137
GS
79 inline void* MallocShared(size_t size)
80 {
f3dccfae
NIS
81 void *result;
82 GetLockShared();
83 result = m_pVMemShared->Malloc(size);
7fcdafbd 84 FreeLockShared();
f3dccfae
NIS
85 return result;
86 };
87 inline void* ReallocShared(void* ptr, size_t size)
88 {
89 void *result;
90 GetLockShared();
91 result = m_pVMemShared->Realloc(ptr, size);
7fcdafbd 92 FreeLockShared();
f3dccfae
NIS
93 return result;
94 };
95 inline void FreeShared(void* ptr)
96 {
97 GetLockShared();
98 m_pVMemShared->Free(ptr);
7fcdafbd 99 FreeLockShared();
7766f137 100 };
7766f137
GS
101 inline void* CallocShared(size_t num, size_t size)
102 {
103 size_t count = num*size;
104 void* lpVoid = MallocShared(count);
105 if (lpVoid)
106 ZeroMemory(lpVoid, count);
107 return lpVoid;
108 };
7766f137
GS
109
110/* IPerlMemParse */
f3dccfae
NIS
111 /* Assume something else is using locks to mangaging serialize
112 on a batch basis
113 */
114 inline void GetLockParse(void) { m_pVMemParse->GetLock(); };
115 inline void FreeLockParse(void) { m_pVMemParse->FreeLock(); };
116 inline int IsLockedParse(void) { return m_pVMemParse->IsLocked(); };
7766f137
GS
117 inline void* MallocParse(size_t size) { return m_pVMemParse->Malloc(size); };
118 inline void* ReallocParse(void* ptr, size_t size) { return m_pVMemParse->Realloc(ptr, size); };
119 inline void FreeParse(void* ptr) { m_pVMemParse->Free(ptr); };
120 inline void* CallocParse(size_t num, size_t size)
121 {
122 size_t count = num*size;
123 void* lpVoid = MallocParse(count);
124 if (lpVoid)
125 ZeroMemory(lpVoid, count);
126 return lpVoid;
127 };
7766f137
GS
128
129/* IPerlEnv */
130 char *Getenv(const char *varname);
131 int Putenv(const char *envstring);
132 inline char *Getenv(const char *varname, unsigned long *len)
133 {
134 *len = 0;
135 char *e = Getenv(varname);
136 if (e)
137 *len = strlen(e);
138 return e;
139 }
140 void* CreateChildEnv(void) { return CreateLocalEnvironmentStrings(*m_pvDir); };
141 void FreeChildEnv(void* pStr) { FreeLocalEnvironmentStrings((char*)pStr); };
142 char* GetChildDir(void);
143 void FreeChildDir(char* pStr);
144 void Reset(void);
145 void Clearenv(void);
146
147 inline LPSTR GetIndex(DWORD &dwIndex)
148 {
149 if(dwIndex < m_dwEnvCount)
150 {
151 ++dwIndex;
152 return m_lppEnvList[dwIndex-1];
153 }
154 return NULL;
155 };
156
157protected:
158 LPSTR Find(LPCSTR lpStr);
159 void Add(LPCSTR lpStr);
160
161 LPSTR CreateLocalEnvironmentStrings(VDir &vDir);
162 void FreeLocalEnvironmentStrings(LPSTR lpStr);
163 LPSTR* Lookup(LPCSTR lpStr);
164 DWORD CalculateEnvironmentSpace(void);
165
166public:
167
168/* IPerlDIR */
169 virtual int Chdir(const char *dirname);
170
171/* IPerllProc */
172 void Abort(void);
173 void Exit(int status);
174 void _Exit(int status);
175 int Execl(const char *cmdname, const char *arg0, const char *arg1, const char *arg2, const char *arg3);
176 int Execv(const char *cmdname, const char *const *argv);
177 int Execvp(const char *cmdname, const char *const *argv);
178
179 inline VMem* GetMemShared(void) { m_pVMemShared->AddRef(); return m_pVMemShared; };
180 inline VMem* GetMemParse(void) { m_pVMemParse->AddRef(); return m_pVMemParse; };
181 inline VDir* GetDir(void) { return m_pvDir; };
182
183public:
184
185 struct IPerlMem m_hostperlMem;
186 struct IPerlMem m_hostperlMemShared;
187 struct IPerlMem m_hostperlMemParse;
188 struct IPerlEnv m_hostperlEnv;
189 struct IPerlStdIO m_hostperlStdIO;
190 struct IPerlLIO m_hostperlLIO;
191 struct IPerlDir m_hostperlDir;
192 struct IPerlSock m_hostperlSock;
193 struct IPerlProc m_hostperlProc;
194
195 struct IPerlMem* m_pHostperlMem;
196 struct IPerlMem* m_pHostperlMemShared;
197 struct IPerlMem* m_pHostperlMemParse;
198 struct IPerlEnv* m_pHostperlEnv;
199 struct IPerlStdIO* m_pHostperlStdIO;
200 struct IPerlLIO* m_pHostperlLIO;
201 struct IPerlDir* m_pHostperlDir;
202 struct IPerlSock* m_pHostperlSock;
203 struct IPerlProc* m_pHostperlProc;
204
205 inline char* MapPathA(const char *pInName) { return m_pvDir->MapPathA(pInName); };
206 inline WCHAR* MapPathW(const WCHAR *pInName) { return m_pvDir->MapPathW(pInName); };
207protected:
208
209 VDir* m_pvDir;
210 VMem* m_pVMem;
211 VMem* m_pVMemShared;
212 VMem* m_pVMemParse;
213
214 DWORD m_dwEnvCount;
215 LPSTR* m_lppEnvList;
52cbf511 216 BOOL m_bTopLevel; // is this a toplevel host?
5f1a76d0
NIS
217 static long num_hosts;
218public:
219 inline int LastHost(void) { return num_hosts == 1L; };
222c300a 220 struct interpreter *host_perl;
7766f137
GS
221};
222
5f1a76d0
NIS
223long CPerlHost::num_hosts = 0L;
224
222c300a 225extern "C" void win32_checkTLS(struct interpreter *host_perl);
7766f137 226
222c300a
NIS
227#define STRUCT2RAWPTR(x, y) (CPerlHost*)(((LPBYTE)x)-offsetof(CPerlHost, y))
228#ifdef CHECK_HOST_INTERP
3fadfdf1 229inline CPerlHost* CheckInterp(CPerlHost *host)
222c300a
NIS
230{
231 win32_checkTLS(host->host_perl);
232 return host;
233}
234#define STRUCT2PTR(x, y) CheckInterp(STRUCT2RAWPTR(x, y))
235#else
236#define STRUCT2PTR(x, y) STRUCT2RAWPTR(x, y)
237#endif
7766f137
GS
238
239inline CPerlHost* IPerlMem2Host(struct IPerlMem* piPerl)
240{
222c300a 241 return STRUCT2RAWPTR(piPerl, m_hostperlMem);
7766f137
GS
242}
243
244inline CPerlHost* IPerlMemShared2Host(struct IPerlMem* piPerl)
245{
05ec9bb3 246 return STRUCT2RAWPTR(piPerl, m_hostperlMemShared);
7766f137
GS
247}
248
249inline CPerlHost* IPerlMemParse2Host(struct IPerlMem* piPerl)
250{
05ec9bb3 251 return STRUCT2RAWPTR(piPerl, m_hostperlMemParse);
7766f137
GS
252}
253
254inline CPerlHost* IPerlEnv2Host(struct IPerlEnv* piPerl)
255{
256 return STRUCT2PTR(piPerl, m_hostperlEnv);
257}
258
259inline CPerlHost* IPerlStdIO2Host(struct IPerlStdIO* piPerl)
260{
261 return STRUCT2PTR(piPerl, m_hostperlStdIO);
262}
263
264inline CPerlHost* IPerlLIO2Host(struct IPerlLIO* piPerl)
265{
266 return STRUCT2PTR(piPerl, m_hostperlLIO);
267}
268
269inline CPerlHost* IPerlDir2Host(struct IPerlDir* piPerl)
270{
271 return STRUCT2PTR(piPerl, m_hostperlDir);
272}
273
274inline CPerlHost* IPerlSock2Host(struct IPerlSock* piPerl)
275{
276 return STRUCT2PTR(piPerl, m_hostperlSock);
277}
278
279inline CPerlHost* IPerlProc2Host(struct IPerlProc* piPerl)
280{
281 return STRUCT2PTR(piPerl, m_hostperlProc);
282}
283
284
285
286#undef IPERL2HOST
287#define IPERL2HOST(x) IPerlMem2Host(x)
288
289/* IPerlMem */
290void*
291PerlMemMalloc(struct IPerlMem* piPerl, size_t size)
292{
293 return IPERL2HOST(piPerl)->Malloc(size);
294}
295void*
296PerlMemRealloc(struct IPerlMem* piPerl, void* ptr, size_t size)
297{
298 return IPERL2HOST(piPerl)->Realloc(ptr, size);
299}
300void
301PerlMemFree(struct IPerlMem* piPerl, void* ptr)
302{
303 IPERL2HOST(piPerl)->Free(ptr);
304}
305void*
306PerlMemCalloc(struct IPerlMem* piPerl, size_t num, size_t size)
307{
308 return IPERL2HOST(piPerl)->Calloc(num, size);
309}
310
311void
312PerlMemGetLock(struct IPerlMem* piPerl)
313{
314 IPERL2HOST(piPerl)->GetLock();
315}
316
317void
318PerlMemFreeLock(struct IPerlMem* piPerl)
319{
320 IPERL2HOST(piPerl)->FreeLock();
321}
322
323int
324PerlMemIsLocked(struct IPerlMem* piPerl)
325{
326 return IPERL2HOST(piPerl)->IsLocked();
327}
328
af2f850f 329const struct IPerlMem perlMem =
7766f137
GS
330{
331 PerlMemMalloc,
332 PerlMemRealloc,
333 PerlMemFree,
334 PerlMemCalloc,
335 PerlMemGetLock,
336 PerlMemFreeLock,
337 PerlMemIsLocked,
338};
339
340#undef IPERL2HOST
341#define IPERL2HOST(x) IPerlMemShared2Host(x)
342
343/* IPerlMemShared */
344void*
345PerlMemSharedMalloc(struct IPerlMem* piPerl, size_t size)
346{
347 return IPERL2HOST(piPerl)->MallocShared(size);
348}
349void*
350PerlMemSharedRealloc(struct IPerlMem* piPerl, void* ptr, size_t size)
351{
352 return IPERL2HOST(piPerl)->ReallocShared(ptr, size);
353}
354void
355PerlMemSharedFree(struct IPerlMem* piPerl, void* ptr)
356{
357 IPERL2HOST(piPerl)->FreeShared(ptr);
358}
359void*
360PerlMemSharedCalloc(struct IPerlMem* piPerl, size_t num, size_t size)
361{
362 return IPERL2HOST(piPerl)->CallocShared(num, size);
363}
364
365void
366PerlMemSharedGetLock(struct IPerlMem* piPerl)
367{
368 IPERL2HOST(piPerl)->GetLockShared();
369}
370
371void
372PerlMemSharedFreeLock(struct IPerlMem* piPerl)
373{
374 IPERL2HOST(piPerl)->FreeLockShared();
375}
376
377int
378PerlMemSharedIsLocked(struct IPerlMem* piPerl)
379{
380 return IPERL2HOST(piPerl)->IsLockedShared();
381}
382
af2f850f 383const struct IPerlMem perlMemShared =
7766f137
GS
384{
385 PerlMemSharedMalloc,
386 PerlMemSharedRealloc,
387 PerlMemSharedFree,
388 PerlMemSharedCalloc,
389 PerlMemSharedGetLock,
390 PerlMemSharedFreeLock,
391 PerlMemSharedIsLocked,
392};
393
394#undef IPERL2HOST
395#define IPERL2HOST(x) IPerlMemParse2Host(x)
396
397/* IPerlMemParse */
398void*
399PerlMemParseMalloc(struct IPerlMem* piPerl, size_t size)
400{
401 return IPERL2HOST(piPerl)->MallocParse(size);
402}
403void*
404PerlMemParseRealloc(struct IPerlMem* piPerl, void* ptr, size_t size)
405{
406 return IPERL2HOST(piPerl)->ReallocParse(ptr, size);
407}
408void
409PerlMemParseFree(struct IPerlMem* piPerl, void* ptr)
410{
411 IPERL2HOST(piPerl)->FreeParse(ptr);
412}
413void*
414PerlMemParseCalloc(struct IPerlMem* piPerl, size_t num, size_t size)
415{
416 return IPERL2HOST(piPerl)->CallocParse(num, size);
417}
418
419void
420PerlMemParseGetLock(struct IPerlMem* piPerl)
421{
422 IPERL2HOST(piPerl)->GetLockParse();
423}
424
425void
426PerlMemParseFreeLock(struct IPerlMem* piPerl)
427{
428 IPERL2HOST(piPerl)->FreeLockParse();
429}
430
431int
432PerlMemParseIsLocked(struct IPerlMem* piPerl)
433{
434 return IPERL2HOST(piPerl)->IsLockedParse();
435}
436
af2f850f 437const struct IPerlMem perlMemParse =
7766f137
GS
438{
439 PerlMemParseMalloc,
440 PerlMemParseRealloc,
441 PerlMemParseFree,
442 PerlMemParseCalloc,
443 PerlMemParseGetLock,
444 PerlMemParseFreeLock,
445 PerlMemParseIsLocked,
446};
447
448
449#undef IPERL2HOST
450#define IPERL2HOST(x) IPerlEnv2Host(x)
451
452/* IPerlEnv */
453char*
454PerlEnvGetenv(struct IPerlEnv* piPerl, const char *varname)
455{
456 return IPERL2HOST(piPerl)->Getenv(varname);
457};
458
459int
460PerlEnvPutenv(struct IPerlEnv* piPerl, const char *envstring)
461{
462 return IPERL2HOST(piPerl)->Putenv(envstring);
463};
464
465char*
466PerlEnvGetenv_len(struct IPerlEnv* piPerl, const char* varname, unsigned long* len)
467{
468 return IPERL2HOST(piPerl)->Getenv(varname, len);
469}
470
471int
472PerlEnvUname(struct IPerlEnv* piPerl, struct utsname *name)
473{
474 return win32_uname(name);
475}
476
477void
478PerlEnvClearenv(struct IPerlEnv* piPerl)
479{
480 IPERL2HOST(piPerl)->Clearenv();
481}
482
483void*
484PerlEnvGetChildenv(struct IPerlEnv* piPerl)
485{
486 return IPERL2HOST(piPerl)->CreateChildEnv();
487}
488
489void
490PerlEnvFreeChildenv(struct IPerlEnv* piPerl, void* childEnv)
491{
492 IPERL2HOST(piPerl)->FreeChildEnv(childEnv);
493}
494
495char*
496PerlEnvGetChilddir(struct IPerlEnv* piPerl)
497{
498 return IPERL2HOST(piPerl)->GetChildDir();
499}
500
501void
502PerlEnvFreeChilddir(struct IPerlEnv* piPerl, char* childDir)
503{
504 IPERL2HOST(piPerl)->FreeChildDir(childDir);
505}
506
507unsigned long
508PerlEnvOsId(struct IPerlEnv* piPerl)
509{
510 return win32_os_id();
511}
512
513char*
6937817d 514PerlEnvLibPath(struct IPerlEnv* piPerl, WIN32_NO_REGISTRY_M_(const char *pl) STRLEN *const len)
7766f137 515{
6937817d 516 return win32_get_privlib(WIN32_NO_REGISTRY_M_(pl) len);
7766f137
GS
517}
518
519char*
e6a0bbf8 520PerlEnvSiteLibPath(struct IPerlEnv* piPerl, const char *pl, STRLEN *const len)
7766f137 521{
1c68cbf7 522 return win32_get_sitelib(pl, len);
7766f137
GS
523}
524
4ea817c6 525char*
e6a0bbf8
NC
526PerlEnvVendorLibPath(struct IPerlEnv* piPerl, const char *pl,
527 STRLEN *const len)
4ea817c6 528{
1c68cbf7 529 return win32_get_vendorlib(pl, len);
4ea817c6
GS
530}
531
635bbe87
GS
532void
533PerlEnvGetChildIO(struct IPerlEnv* piPerl, child_IO_table* ptr)
534{
535 win32_get_child_IO(ptr);
536}
537
af2f850f 538const struct IPerlEnv perlEnv =
7766f137
GS
539{
540 PerlEnvGetenv,
541 PerlEnvPutenv,
542 PerlEnvGetenv_len,
543 PerlEnvUname,
544 PerlEnvClearenv,
545 PerlEnvGetChildenv,
546 PerlEnvFreeChildenv,
547 PerlEnvGetChilddir,
548 PerlEnvFreeChilddir,
549 PerlEnvOsId,
550 PerlEnvLibPath,
551 PerlEnvSiteLibPath,
4ea817c6 552 PerlEnvVendorLibPath,
635bbe87 553 PerlEnvGetChildIO,
7766f137
GS
554};
555
556#undef IPERL2HOST
557#define IPERL2HOST(x) IPerlStdIO2Host(x)
558
559/* PerlStdIO */
adb71456 560FILE*
7766f137
GS
561PerlStdIOStdin(struct IPerlStdIO* piPerl)
562{
adb71456 563 return win32_stdin();
7766f137
GS
564}
565
adb71456 566FILE*
7766f137
GS
567PerlStdIOStdout(struct IPerlStdIO* piPerl)
568{
adb71456 569 return win32_stdout();
7766f137
GS
570}
571
adb71456 572FILE*
7766f137
GS
573PerlStdIOStderr(struct IPerlStdIO* piPerl)
574{
adb71456 575 return win32_stderr();
7766f137
GS
576}
577
adb71456 578FILE*
7766f137
GS
579PerlStdIOOpen(struct IPerlStdIO* piPerl, const char *path, const char *mode)
580{
adb71456 581 return win32_fopen(path, mode);
7766f137
GS
582}
583
584int
adb71456 585PerlStdIOClose(struct IPerlStdIO* piPerl, FILE* pf)
7766f137 586{
adb71456 587 return win32_fclose((pf));
7766f137
GS
588}
589
590int
adb71456 591PerlStdIOEof(struct IPerlStdIO* piPerl, FILE* pf)
7766f137 592{
adb71456 593 return win32_feof(pf);
7766f137
GS
594}
595
596int
adb71456 597PerlStdIOError(struct IPerlStdIO* piPerl, FILE* pf)
7766f137 598{
adb71456 599 return win32_ferror(pf);
7766f137
GS
600}
601
602void
adb71456 603PerlStdIOClearerr(struct IPerlStdIO* piPerl, FILE* pf)
7766f137 604{
adb71456 605 win32_clearerr(pf);
7766f137
GS
606}
607
608int
adb71456 609PerlStdIOGetc(struct IPerlStdIO* piPerl, FILE* pf)
7766f137 610{
adb71456 611 return win32_getc(pf);
7766f137
GS
612}
613
0934c9d9 614STDCHAR*
adb71456 615PerlStdIOGetBase(struct IPerlStdIO* piPerl, FILE* pf)
7766f137
GS
616{
617#ifdef FILE_base
adb71456 618 FILE *f = pf;
7766f137
GS
619 return FILE_base(f);
620#else
4e205ed6 621 return NULL;
7766f137
GS
622#endif
623}
624
625int
adb71456 626PerlStdIOGetBufsiz(struct IPerlStdIO* piPerl, FILE* pf)
7766f137
GS
627{
628#ifdef FILE_bufsiz
adb71456 629 FILE *f = pf;
7766f137
GS
630 return FILE_bufsiz(f);
631#else
632 return (-1);
633#endif
634}
635
636int
adb71456 637PerlStdIOGetCnt(struct IPerlStdIO* piPerl, FILE* pf)
7766f137
GS
638{
639#ifdef USE_STDIO_PTR
adb71456 640 FILE *f = pf;
7766f137
GS
641 return FILE_cnt(f);
642#else
643 return (-1);
644#endif
645}
646
0934c9d9 647STDCHAR*
adb71456 648PerlStdIOGetPtr(struct IPerlStdIO* piPerl, FILE* pf)
7766f137
GS
649{
650#ifdef USE_STDIO_PTR
adb71456 651 FILE *f = pf;
7766f137
GS
652 return FILE_ptr(f);
653#else
4e205ed6 654 return NULL;
7766f137
GS
655#endif
656}
657
658char*
6d655123 659PerlStdIOGets(struct IPerlStdIO* piPerl, char* s, int n, FILE* pf)
7766f137 660{
adb71456 661 return win32_fgets(s, n, pf);
7766f137
GS
662}
663
664int
50a4e535 665PerlStdIOPutc(struct IPerlStdIO* piPerl, int c, FILE* pf)
7766f137 666{
adb71456 667 return win32_fputc(c, pf);
7766f137
GS
668}
669
670int
50a4e535 671PerlStdIOPuts(struct IPerlStdIO* piPerl, const char *s, FILE* pf)
7766f137 672{
adb71456 673 return win32_fputs(s, pf);
7766f137
GS
674}
675
676int
adb71456 677PerlStdIOFlush(struct IPerlStdIO* piPerl, FILE* pf)
7766f137 678{
adb71456 679 return win32_fflush(pf);
7766f137
GS
680}
681
682int
adb71456 683PerlStdIOUngetc(struct IPerlStdIO* piPerl,int c, FILE* pf)
7766f137 684{
adb71456 685 return win32_ungetc(c, pf);
7766f137
GS
686}
687
688int
adb71456 689PerlStdIOFileno(struct IPerlStdIO* piPerl, FILE* pf)
7766f137 690{
adb71456 691 return win32_fileno(pf);
7766f137
GS
692}
693
adb71456 694FILE*
7766f137
GS
695PerlStdIOFdopen(struct IPerlStdIO* piPerl, int fd, const char *mode)
696{
adb71456 697 return win32_fdopen(fd, mode);
7766f137
GS
698}
699
adb71456
NIS
700FILE*
701PerlStdIOReopen(struct IPerlStdIO* piPerl, const char*path, const char*mode, FILE* pf)
7766f137 702{
adb71456 703 return win32_freopen(path, mode, (FILE*)pf);
7766f137
GS
704}
705
706SSize_t
adb71456 707PerlStdIORead(struct IPerlStdIO* piPerl, void *buffer, Size_t size, Size_t count, FILE* pf)
7766f137 708{
adb71456 709 return win32_fread(buffer, size, count, pf);
7766f137
GS
710}
711
712SSize_t
adb71456 713PerlStdIOWrite(struct IPerlStdIO* piPerl, const void *buffer, Size_t size, Size_t count, FILE* pf)
7766f137 714{
adb71456 715 return win32_fwrite(buffer, size, count, pf);
7766f137
GS
716}
717
718void
adb71456 719PerlStdIOSetBuf(struct IPerlStdIO* piPerl, FILE* pf, char* buffer)
7766f137 720{
adb71456 721 win32_setbuf(pf, buffer);
7766f137
GS
722}
723
724int
adb71456 725PerlStdIOSetVBuf(struct IPerlStdIO* piPerl, FILE* pf, char* buffer, int type, Size_t size)
7766f137 726{
adb71456 727 return win32_setvbuf(pf, buffer, type, size);
7766f137
GS
728}
729
730void
adb71456 731PerlStdIOSetCnt(struct IPerlStdIO* piPerl, FILE* pf, int n)
7766f137
GS
732{
733#ifdef STDIO_CNT_LVALUE
adb71456 734 FILE *f = pf;
7766f137
GS
735 FILE_cnt(f) = n;
736#endif
737}
738
739void
0934c9d9 740PerlStdIOSetPtr(struct IPerlStdIO* piPerl, FILE* pf, STDCHAR * ptr)
7766f137
GS
741{
742#ifdef STDIO_PTR_LVALUE
adb71456 743 FILE *f = pf;
7766f137 744 FILE_ptr(f) = ptr;
7766f137
GS
745#endif
746}
747
748void
adb71456 749PerlStdIOSetlinebuf(struct IPerlStdIO* piPerl, FILE* pf)
7766f137 750{
adb71456 751 win32_setvbuf(pf, NULL, _IOLBF, 0);
7766f137
GS
752}
753
754int
adb71456 755PerlStdIOPrintf(struct IPerlStdIO* piPerl, FILE* pf, const char *format,...)
7766f137
GS
756{
757 va_list(arglist);
758 va_start(arglist, format);
adb71456 759 return win32_vfprintf(pf, format, arglist);
7766f137
GS
760}
761
762int
adb71456 763PerlStdIOVprintf(struct IPerlStdIO* piPerl, FILE* pf, const char *format, va_list arglist)
7766f137 764{
adb71456 765 return win32_vfprintf(pf, format, arglist);
7766f137
GS
766}
767
c623ac67 768Off_t
adb71456 769PerlStdIOTell(struct IPerlStdIO* piPerl, FILE* pf)
7766f137 770{
adb71456 771 return win32_ftell(pf);
7766f137
GS
772}
773
774int
c623ac67 775PerlStdIOSeek(struct IPerlStdIO* piPerl, FILE* pf, Off_t offset, int origin)
7766f137 776{
adb71456 777 return win32_fseek(pf, offset, origin);
7766f137
GS
778}
779
780void
adb71456 781PerlStdIORewind(struct IPerlStdIO* piPerl, FILE* pf)
7766f137 782{
adb71456 783 win32_rewind(pf);
7766f137
GS
784}
785
adb71456 786FILE*
7766f137
GS
787PerlStdIOTmpfile(struct IPerlStdIO* piPerl)
788{
adb71456 789 return win32_tmpfile();
7766f137
GS
790}
791
792int
adb71456 793PerlStdIOGetpos(struct IPerlStdIO* piPerl, FILE* pf, Fpos_t *p)
7766f137 794{
adb71456 795 return win32_fgetpos(pf, p);
7766f137
GS
796}
797
798int
adb71456 799PerlStdIOSetpos(struct IPerlStdIO* piPerl, FILE* pf, const Fpos_t *p)
7766f137 800{
adb71456 801 return win32_fsetpos(pf, p);
7766f137
GS
802}
803void
804PerlStdIOInit(struct IPerlStdIO* piPerl)
805{
806}
807
808void
809PerlStdIOInitOSExtras(struct IPerlStdIO* piPerl)
810{
811 Perl_init_os_extras();
812}
813
814int
c623ac67 815PerlStdIOOpenOSfhandle(struct IPerlStdIO* piPerl, intptr_t osfhandle, int flags)
7766f137
GS
816{
817 return win32_open_osfhandle(osfhandle, flags);
818}
819
c623ac67 820intptr_t
7766f137
GS
821PerlStdIOGetOSfhandle(struct IPerlStdIO* piPerl, int filenum)
822{
823 return win32_get_osfhandle(filenum);
824}
825
adb71456
NIS
826FILE*
827PerlStdIOFdupopen(struct IPerlStdIO* piPerl, FILE* pf)
7766f137 828{
adb71456 829 FILE* pfdup;
7766f137
GS
830 fpos_t pos;
831 char mode[3];
adb71456 832 int fileno = win32_dup(win32_fileno(pf));
7766f137
GS
833
834 /* open the file in the same mode */
1f664ef5 835 if (PERLIO_FILE_flag(pf) & PERLIO_FILE_flag_RD) {
7766f137
GS
836 mode[0] = 'r';
837 mode[1] = 0;
838 }
1f664ef5 839 else if (PERLIO_FILE_flag(pf) & PERLIO_FILE_flag_WR) {
7766f137
GS
840 mode[0] = 'a';
841 mode[1] = 0;
842 }
1f664ef5 843 else if (PERLIO_FILE_flag(pf) & PERLIO_FILE_flag_RW) {
7766f137
GS
844 mode[0] = 'r';
845 mode[1] = '+';
846 mode[2] = 0;
847 }
848
f3dccfae 849 /* it appears that the binmode is attached to the
7766f137
GS
850 * file descriptor so binmode files will be handled
851 * correctly
852 */
adb71456 853 pfdup = win32_fdopen(fileno, mode);
7766f137
GS
854
855 /* move the file pointer to the same position */
adb71456
NIS
856 if (!fgetpos(pf, &pos)) {
857 fsetpos(pfdup, &pos);
7766f137
GS
858 }
859 return pfdup;
860}
861
af2f850f 862const struct IPerlStdIO perlStdIO =
7766f137
GS
863{
864 PerlStdIOStdin,
865 PerlStdIOStdout,
866 PerlStdIOStderr,
867 PerlStdIOOpen,
868 PerlStdIOClose,
869 PerlStdIOEof,
870 PerlStdIOError,
871 PerlStdIOClearerr,
872 PerlStdIOGetc,
873 PerlStdIOGetBase,
874 PerlStdIOGetBufsiz,
875 PerlStdIOGetCnt,
876 PerlStdIOGetPtr,
877 PerlStdIOGets,
878 PerlStdIOPutc,
879 PerlStdIOPuts,
880 PerlStdIOFlush,
881 PerlStdIOUngetc,
882 PerlStdIOFileno,
883 PerlStdIOFdopen,
884 PerlStdIOReopen,
885 PerlStdIORead,
886 PerlStdIOWrite,
887 PerlStdIOSetBuf,
888 PerlStdIOSetVBuf,
889 PerlStdIOSetCnt,
adb71456 890 PerlStdIOSetPtr,
7766f137
GS
891 PerlStdIOSetlinebuf,
892 PerlStdIOPrintf,
893 PerlStdIOVprintf,
894 PerlStdIOTell,
895 PerlStdIOSeek,
896 PerlStdIORewind,
897 PerlStdIOTmpfile,
898 PerlStdIOGetpos,
899 PerlStdIOSetpos,
900 PerlStdIOInit,
901 PerlStdIOInitOSExtras,
902 PerlStdIOFdupopen,
903};
904
905
906#undef IPERL2HOST
907#define IPERL2HOST(x) IPerlLIO2Host(x)
908
909/* IPerlLIO */
910int
911PerlLIOAccess(struct IPerlLIO* piPerl, const char *path, int mode)
912{
913 return win32_access(path, mode);
914}
915
916int
917PerlLIOChmod(struct IPerlLIO* piPerl, const char *filename, int pmode)
918{
919 return win32_chmod(filename, pmode);
920}
921
922int
923PerlLIOChown(struct IPerlLIO* piPerl, const char *filename, uid_t owner, gid_t group)
924{
925 return chown(filename, owner, group);
926}
927
928int
4a9d6100 929PerlLIOChsize(struct IPerlLIO* piPerl, int handle, Off_t size)
7766f137 930{
4a9d6100 931 return win32_chsize(handle, size);
7766f137
GS
932}
933
934int
935PerlLIOClose(struct IPerlLIO* piPerl, int handle)
936{
937 return win32_close(handle);
938}
939
940int
941PerlLIODup(struct IPerlLIO* piPerl, int handle)
942{
943 return win32_dup(handle);
944}
945
946int
947PerlLIODup2(struct IPerlLIO* piPerl, int handle1, int handle2)
948{
949 return win32_dup2(handle1, handle2);
950}
951
952int
953PerlLIOFlock(struct IPerlLIO* piPerl, int fd, int oper)
954{
955 return win32_flock(fd, oper);
956}
957
958int
c623ac67 959PerlLIOFileStat(struct IPerlLIO* piPerl, int handle, Stat_t *buffer)
7766f137 960{
1889e8b0 961 return win32_fstat(handle, buffer);
7766f137
GS
962}
963
964int
965PerlLIOIOCtl(struct IPerlLIO* piPerl, int i, unsigned int u, char *data)
966{
0a23e5bf
SH
967 u_long u_long_arg;
968 int retval;
969
970 /* mauke says using memcpy avoids alignment issues */
971 memcpy(&u_long_arg, data, sizeof u_long_arg);
972 retval = win32_ioctlsocket((SOCKET)i, (long)u, &u_long_arg);
973 memcpy(data, &u_long_arg, sizeof u_long_arg);
974 return retval;
7766f137
GS
975}
976
977int
978PerlLIOIsatty(struct IPerlLIO* piPerl, int fd)
979{
4342f4d6 980 return win32_isatty(fd);
7766f137
GS
981}
982
983int
984PerlLIOLink(struct IPerlLIO* piPerl, const char*oldname, const char *newname)
985{
986 return win32_link(oldname, newname);
987}
988
c623ac67
GS
989Off_t
990PerlLIOLseek(struct IPerlLIO* piPerl, int handle, Off_t offset, int origin)
7766f137
GS
991{
992 return win32_lseek(handle, offset, origin);
993}
994
995int
c623ac67 996PerlLIOLstat(struct IPerlLIO* piPerl, const char *path, Stat_t *buffer)
7766f137 997{
92b3a3eb 998 return win32_lstat(path, buffer);
7766f137
GS
999}
1000
1001char*
1002PerlLIOMktemp(struct IPerlLIO* piPerl, char *Template)
1003{
1004 return mktemp(Template);
1005}
1006
1007int
1008PerlLIOOpen(struct IPerlLIO* piPerl, const char *filename, int oflag)
1009{
1010 return win32_open(filename, oflag);
1011}
1012
1013int
1014PerlLIOOpen3(struct IPerlLIO* piPerl, const char *filename, int oflag, int pmode)
1015{
1016 return win32_open(filename, oflag, pmode);
1017}
1018
1019int
1020PerlLIORead(struct IPerlLIO* piPerl, int handle, void *buffer, unsigned int count)
1021{
1022 return win32_read(handle, buffer, count);
1023}
1024
1025int
1026PerlLIORename(struct IPerlLIO* piPerl, const char *OldFileName, const char *newname)
1027{
1028 return win32_rename(OldFileName, newname);
1029}
1030
1031int
1032PerlLIOSetmode(struct IPerlLIO* piPerl, int handle, int mode)
1033{
1034 return win32_setmode(handle, mode);
1035}
1036
1037int
c623ac67 1038PerlLIONameStat(struct IPerlLIO* piPerl, const char *path, Stat_t *buffer)
7766f137
GS
1039{
1040 return win32_stat(path, buffer);
1041}
1042
1043char*
1044PerlLIOTmpnam(struct IPerlLIO* piPerl, char *string)
1045{
1046 return tmpnam(string);
1047}
1048
1049int
1050PerlLIOUmask(struct IPerlLIO* piPerl, int pmode)
1051{
1052 return umask(pmode);
1053}
1054
1055int
1056PerlLIOUnlink(struct IPerlLIO* piPerl, const char *filename)
1057{
1058 return win32_unlink(filename);
1059}
1060
1061int
c3ff6b30 1062PerlLIOUtime(struct IPerlLIO* piPerl, const char *filename, struct utimbuf *times)
7766f137
GS
1063{
1064 return win32_utime(filename, times);
1065}
1066
1067int
1068PerlLIOWrite(struct IPerlLIO* piPerl, int handle, const void *buffer, unsigned int count)
1069{
1070 return win32_write(handle, buffer, count);
1071}
1072
af2f850f 1073const struct IPerlLIO perlLIO =
7766f137
GS
1074{
1075 PerlLIOAccess,
1076 PerlLIOChmod,
1077 PerlLIOChown,
1078 PerlLIOChsize,
1079 PerlLIOClose,
1080 PerlLIODup,
1081 PerlLIODup2,
1082 PerlLIOFlock,
1083 PerlLIOFileStat,
1084 PerlLIOIOCtl,
1085 PerlLIOIsatty,
1086 PerlLIOLink,
1087 PerlLIOLseek,
1088 PerlLIOLstat,
1089 PerlLIOMktemp,
1090 PerlLIOOpen,
1091 PerlLIOOpen3,
1092 PerlLIORead,
1093 PerlLIORename,
1094 PerlLIOSetmode,
1095 PerlLIONameStat,
1096 PerlLIOTmpnam,
1097 PerlLIOUmask,
1098 PerlLIOUnlink,
1099 PerlLIOUtime,
1100 PerlLIOWrite,
1101};
1102
1103
1104#undef IPERL2HOST
1105#define IPERL2HOST(x) IPerlDir2Host(x)
1106
1107/* IPerlDIR */
1108int
1109PerlDirMakedir(struct IPerlDir* piPerl, const char *dirname, int mode)
1110{
1111 return win32_mkdir(dirname, mode);
1112}
1113
1114int
1115PerlDirChdir(struct IPerlDir* piPerl, const char *dirname)
1116{
1117 return IPERL2HOST(piPerl)->Chdir(dirname);
1118}
1119
1120int
1121PerlDirRmdir(struct IPerlDir* piPerl, const char *dirname)
1122{
1123 return win32_rmdir(dirname);
1124}
1125
1126int
1127PerlDirClose(struct IPerlDir* piPerl, DIR *dirp)
1128{
1129 return win32_closedir(dirp);
1130}
1131
1132DIR*
0e06f75d 1133PerlDirOpen(struct IPerlDir* piPerl, const char *filename)
7766f137
GS
1134{
1135 return win32_opendir(filename);
1136}
1137
1138struct direct *
1139PerlDirRead(struct IPerlDir* piPerl, DIR *dirp)
1140{
1141 return win32_readdir(dirp);
1142}
1143
1144void
1145PerlDirRewind(struct IPerlDir* piPerl, DIR *dirp)
1146{
1147 win32_rewinddir(dirp);
1148}
1149
1150void
1151PerlDirSeek(struct IPerlDir* piPerl, DIR *dirp, long loc)
1152{
1153 win32_seekdir(dirp, loc);
1154}
1155
1156long
1157PerlDirTell(struct IPerlDir* piPerl, DIR *dirp)
1158{
1159 return win32_telldir(dirp);
1160}
1161
1162char*
1163PerlDirMapPathA(struct IPerlDir* piPerl, const char* path)
1164{
1165 return IPERL2HOST(piPerl)->MapPathA(path);
1166}
1167
1168WCHAR*
1169PerlDirMapPathW(struct IPerlDir* piPerl, const WCHAR* path)
1170{
1171 return IPERL2HOST(piPerl)->MapPathW(path);
1172}
1173
af2f850f 1174const struct IPerlDir perlDir =
7766f137
GS
1175{
1176 PerlDirMakedir,
1177 PerlDirChdir,
1178 PerlDirRmdir,
1179 PerlDirClose,
1180 PerlDirOpen,
1181 PerlDirRead,
1182 PerlDirRewind,
1183 PerlDirSeek,
1184 PerlDirTell,
1185 PerlDirMapPathA,
1186 PerlDirMapPathW,
1187};
1188
1189
1190/* IPerlSock */
1191u_long
1192PerlSockHtonl(struct IPerlSock* piPerl, u_long hostlong)
1193{
1194 return win32_htonl(hostlong);
1195}
1196
1197u_short
1198PerlSockHtons(struct IPerlSock* piPerl, u_short hostshort)
1199{
1200 return win32_htons(hostshort);
1201}
1202
1203u_long
1204PerlSockNtohl(struct IPerlSock* piPerl, u_long netlong)
1205{
1206 return win32_ntohl(netlong);
1207}
1208
1209u_short
1210PerlSockNtohs(struct IPerlSock* piPerl, u_short netshort)
1211{
1212 return win32_ntohs(netshort);
1213}
1214
1215SOCKET PerlSockAccept(struct IPerlSock* piPerl, SOCKET s, struct sockaddr* addr, int* addrlen)
1216{
1217 return win32_accept(s, addr, addrlen);
1218}
1219
1220int
1221PerlSockBind(struct IPerlSock* piPerl, SOCKET s, const struct sockaddr* name, int namelen)
1222{
1223 return win32_bind(s, name, namelen);
1224}
1225
1226int
1227PerlSockConnect(struct IPerlSock* piPerl, SOCKET s, const struct sockaddr* name, int namelen)
1228{
1229 return win32_connect(s, name, namelen);
1230}
1231
1232void
1233PerlSockEndhostent(struct IPerlSock* piPerl)
1234{
1235 win32_endhostent();
1236}
1237
1238void
1239PerlSockEndnetent(struct IPerlSock* piPerl)
1240{
1241 win32_endnetent();
1242}
1243
1244void
1245PerlSockEndprotoent(struct IPerlSock* piPerl)
1246{
1247 win32_endprotoent();
1248}
1249
1250void
1251PerlSockEndservent(struct IPerlSock* piPerl)
1252{
1253 win32_endservent();
1254}
1255
1256struct hostent*
1257PerlSockGethostbyaddr(struct IPerlSock* piPerl, const char* addr, int len, int type)
1258{
1259 return win32_gethostbyaddr(addr, len, type);
1260}
1261
1262struct hostent*
1263PerlSockGethostbyname(struct IPerlSock* piPerl, const char* name)
1264{
1265 return win32_gethostbyname(name);
1266}
1267
1268struct hostent*
1269PerlSockGethostent(struct IPerlSock* piPerl)
1270{
073dd035 1271 win32_croak_not_implemented("gethostent");
7766f137
GS
1272 return NULL;
1273}
1274
1275int
1276PerlSockGethostname(struct IPerlSock* piPerl, char* name, int namelen)
1277{
1278 return win32_gethostname(name, namelen);
1279}
1280
1281struct netent *
1282PerlSockGetnetbyaddr(struct IPerlSock* piPerl, long net, int type)
1283{
1284 return win32_getnetbyaddr(net, type);
1285}
1286
1287struct netent *
1288PerlSockGetnetbyname(struct IPerlSock* piPerl, const char *name)
1289{
1290 return win32_getnetbyname((char*)name);
1291}
1292
1293struct netent *
1294PerlSockGetnetent(struct IPerlSock* piPerl)
1295{
1296 return win32_getnetent();
1297}
1298
1299int PerlSockGetpeername(struct IPerlSock* piPerl, SOCKET s, struct sockaddr* name, int* namelen)
1300{
1301 return win32_getpeername(s, name, namelen);
1302}
1303
1304struct protoent*
1305PerlSockGetprotobyname(struct IPerlSock* piPerl, const char* name)
1306{
1307 return win32_getprotobyname(name);
1308}
1309
1310struct protoent*
1311PerlSockGetprotobynumber(struct IPerlSock* piPerl, int number)
1312{
1313 return win32_getprotobynumber(number);
1314}
1315
1316struct protoent*
1317PerlSockGetprotoent(struct IPerlSock* piPerl)
1318{
1319 return win32_getprotoent();
1320}
1321
1322struct servent*
1323PerlSockGetservbyname(struct IPerlSock* piPerl, const char* name, const char* proto)
1324{
1325 return win32_getservbyname(name, proto);
1326}
1327
1328struct servent*
1329PerlSockGetservbyport(struct IPerlSock* piPerl, int port, const char* proto)
1330{
1331 return win32_getservbyport(port, proto);
1332}
1333
1334struct servent*
1335PerlSockGetservent(struct IPerlSock* piPerl)
1336{
1337 return win32_getservent();
1338}
1339
1340int
1341PerlSockGetsockname(struct IPerlSock* piPerl, SOCKET s, struct sockaddr* name, int* namelen)
1342{
1343 return win32_getsockname(s, name, namelen);
1344}
1345
1346int
1347PerlSockGetsockopt(struct IPerlSock* piPerl, SOCKET s, int level, int optname, char* optval, int* optlen)
1348{
1349 return win32_getsockopt(s, level, optname, optval, optlen);
1350}
1351
1352unsigned long
1353PerlSockInetAddr(struct IPerlSock* piPerl, const char* cp)
1354{
1355 return win32_inet_addr(cp);
1356}
1357
1358char*
1359PerlSockInetNtoa(struct IPerlSock* piPerl, struct in_addr in)
1360{
1361 return win32_inet_ntoa(in);
1362}
1363
1364int
1365PerlSockListen(struct IPerlSock* piPerl, SOCKET s, int backlog)
1366{
1367 return win32_listen(s, backlog);
1368}
1369
1370int
1371PerlSockRecv(struct IPerlSock* piPerl, SOCKET s, char* buffer, int len, int flags)
1372{
1373 return win32_recv(s, buffer, len, flags);
1374}
1375
1376int
1377PerlSockRecvfrom(struct IPerlSock* piPerl, SOCKET s, char* buffer, int len, int flags, struct sockaddr* from, int* fromlen)
1378{
1379 return win32_recvfrom(s, buffer, len, flags, from, fromlen);
1380}
1381
1382int
1383PerlSockSelect(struct IPerlSock* piPerl, int nfds, char* readfds, char* writefds, char* exceptfds, const struct timeval* timeout)
1384{
1385 return win32_select(nfds, (Perl_fd_set*)readfds, (Perl_fd_set*)writefds, (Perl_fd_set*)exceptfds, timeout);
1386}
1387
1388int
1389PerlSockSend(struct IPerlSock* piPerl, SOCKET s, const char* buffer, int len, int flags)
1390{
1391 return win32_send(s, buffer, len, flags);
1392}
1393
1394int
1395PerlSockSendto(struct IPerlSock* piPerl, SOCKET s, const char* buffer, int len, int flags, const struct sockaddr* to, int tolen)
1396{
1397 return win32_sendto(s, buffer, len, flags, to, tolen);
1398}
1399
1400void
1401PerlSockSethostent(struct IPerlSock* piPerl, int stayopen)
1402{
1403 win32_sethostent(stayopen);
1404}
1405
1406void
1407PerlSockSetnetent(struct IPerlSock* piPerl, int stayopen)
1408{
1409 win32_setnetent(stayopen);
1410}
1411
1412void
1413PerlSockSetprotoent(struct IPerlSock* piPerl, int stayopen)
1414{
1415 win32_setprotoent(stayopen);
1416}
1417
1418void
1419PerlSockSetservent(struct IPerlSock* piPerl, int stayopen)
1420{
1421 win32_setservent(stayopen);
1422}
1423
1424int
1425PerlSockSetsockopt(struct IPerlSock* piPerl, SOCKET s, int level, int optname, const char* optval, int optlen)
1426{
1427 return win32_setsockopt(s, level, optname, optval, optlen);
1428}
1429
1430int
1431PerlSockShutdown(struct IPerlSock* piPerl, SOCKET s, int how)
1432{
1433 return win32_shutdown(s, how);
1434}
1435
1436SOCKET
1437PerlSockSocket(struct IPerlSock* piPerl, int af, int type, int protocol)
1438{
1439 return win32_socket(af, type, protocol);
1440}
1441
1442int
1443PerlSockSocketpair(struct IPerlSock* piPerl, int domain, int type, int protocol, int* fds)
1444{
e10bb1e9 1445 return Perl_my_socketpair(domain, type, protocol, fds);
7766f137
GS
1446}
1447
1448int
1449PerlSockClosesocket(struct IPerlSock* piPerl, SOCKET s)
1450{
1451 return win32_closesocket(s);
1452}
1453
1454int
1455PerlSockIoctlsocket(struct IPerlSock* piPerl, SOCKET s, long cmd, u_long *argp)
1456{
1457 return win32_ioctlsocket(s, cmd, argp);
1458}
1459
af2f850f 1460const struct IPerlSock perlSock =
7766f137
GS
1461{
1462 PerlSockHtonl,
1463 PerlSockHtons,
1464 PerlSockNtohl,
1465 PerlSockNtohs,
1466 PerlSockAccept,
1467 PerlSockBind,
1468 PerlSockConnect,
1469 PerlSockEndhostent,
1470 PerlSockEndnetent,
1471 PerlSockEndprotoent,
1472 PerlSockEndservent,
1473 PerlSockGethostname,
1474 PerlSockGetpeername,
1475 PerlSockGethostbyaddr,
1476 PerlSockGethostbyname,
1477 PerlSockGethostent,
1478 PerlSockGetnetbyaddr,
1479 PerlSockGetnetbyname,
1480 PerlSockGetnetent,
1481 PerlSockGetprotobyname,
1482 PerlSockGetprotobynumber,
1483 PerlSockGetprotoent,
1484 PerlSockGetservbyname,
1485 PerlSockGetservbyport,
1486 PerlSockGetservent,
1487 PerlSockGetsockname,
1488 PerlSockGetsockopt,
1489 PerlSockInetAddr,
1490 PerlSockInetNtoa,
1491 PerlSockListen,
1492 PerlSockRecv,
1493 PerlSockRecvfrom,
1494 PerlSockSelect,
1495 PerlSockSend,
1496 PerlSockSendto,
1497 PerlSockSethostent,
1498 PerlSockSetnetent,
1499 PerlSockSetprotoent,
1500 PerlSockSetservent,
1501 PerlSockSetsockopt,
1502 PerlSockShutdown,
1503 PerlSockSocket,
1504 PerlSockSocketpair,
1505 PerlSockClosesocket,
1506};
1507
1508
1509/* IPerlProc */
1510
1511#define EXECF_EXEC 1
1512#define EXECF_SPAWN 2
1513
1514void
1515PerlProcAbort(struct IPerlProc* piPerl)
1516{
1517 win32_abort();
1518}
1519
1520char *
1521PerlProcCrypt(struct IPerlProc* piPerl, const char* clear, const char* salt)
1522{
1523 return win32_crypt(clear, salt);
1524}
1525
084b56d7 1526PERL_CALLCONV_NO_RET void
7766f137
GS
1527PerlProcExit(struct IPerlProc* piPerl, int status)
1528{
1529 exit(status);
1530}
1531
084b56d7 1532PERL_CALLCONV_NO_RET void
7766f137
GS
1533PerlProc_Exit(struct IPerlProc* piPerl, int status)
1534{
1535 _exit(status);
1536}
1537
1538int
1539PerlProcExecl(struct IPerlProc* piPerl, const char *cmdname, const char *arg0, const char *arg1, const char *arg2, const char *arg3)
1540{
1541 return execl(cmdname, arg0, arg1, arg2, arg3);
1542}
1543
1544int
1545PerlProcExecv(struct IPerlProc* piPerl, const char *cmdname, const char *const *argv)
1546{
1547 return win32_execvp(cmdname, argv);
1548}
1549
1550int
1551PerlProcExecvp(struct IPerlProc* piPerl, const char *cmdname, const char *const *argv)
1552{
1553 return win32_execvp(cmdname, argv);
1554}
1555
1556uid_t
1557PerlProcGetuid(struct IPerlProc* piPerl)
1558{
1559 return getuid();
1560}
1561
1562uid_t
1563PerlProcGeteuid(struct IPerlProc* piPerl)
1564{
1565 return geteuid();
1566}
1567
1568gid_t
1569PerlProcGetgid(struct IPerlProc* piPerl)
1570{
1571 return getgid();
1572}
1573
1574gid_t
1575PerlProcGetegid(struct IPerlProc* piPerl)
1576{
1577 return getegid();
1578}
1579
1580char *
1581PerlProcGetlogin(struct IPerlProc* piPerl)
1582{
1583 return g_getlogin();
1584}
1585
1586int
1587PerlProcKill(struct IPerlProc* piPerl, int pid, int sig)
1588{
1589 return win32_kill(pid, sig);
1590}
1591
1592int
1593PerlProcKillpg(struct IPerlProc* piPerl, int pid, int sig)
1594{
542cb85f 1595 return win32_kill(pid, -sig);
7766f137
GS
1596}
1597
1598int
1599PerlProcPauseProc(struct IPerlProc* piPerl)
1600{
bbc9927b 1601 return win32_pause();
7766f137
GS
1602}
1603
1604PerlIO*
1605PerlProcPopen(struct IPerlProc* piPerl, const char *command, const char *mode)
1606{
acfe0abc 1607 dTHX;
7766f137 1608 PERL_FLUSHALL_FOR_CHILD;
adb71456 1609 return win32_popen(command, mode);
7766f137
GS
1610}
1611
8c0134a8
NIS
1612PerlIO*
1613PerlProcPopenList(struct IPerlProc* piPerl, const char *mode, IV narg, SV **args)
1614{
acfe0abc 1615 dTHX;
8c0134a8
NIS
1616 PERL_FLUSHALL_FOR_CHILD;
1617 return win32_popenlist(mode, narg, args);
1618}
1619
7766f137
GS
1620int
1621PerlProcPclose(struct IPerlProc* piPerl, PerlIO *stream)
1622{
adb71456 1623 return win32_pclose(stream);
7766f137
GS
1624}
1625
1626int
1627PerlProcPipe(struct IPerlProc* piPerl, int *phandles)
1628{
1629 return win32_pipe(phandles, 512, O_BINARY);
1630}
1631
1632int
1633PerlProcSetuid(struct IPerlProc* piPerl, uid_t u)
1634{
1635 return setuid(u);
1636}
1637
1638int
1639PerlProcSetgid(struct IPerlProc* piPerl, gid_t g)
1640{
1641 return setgid(g);
1642}
1643
1644int
1645PerlProcSleep(struct IPerlProc* piPerl, unsigned int s)
1646{
1647 return win32_sleep(s);
1648}
1649
1650int
1651PerlProcTimes(struct IPerlProc* piPerl, struct tms *timebuf)
1652{
1653 return win32_times(timebuf);
1654}
1655
1656int
1657PerlProcWait(struct IPerlProc* piPerl, int *status)
1658{
1659 return win32_wait(status);
1660}
1661
1662int
1663PerlProcWaitpid(struct IPerlProc* piPerl, int pid, int *status, int flags)
1664{
1665 return win32_waitpid(pid, status, flags);
1666}
1667
1668Sighandler_t
1669PerlProcSignal(struct IPerlProc* piPerl, int sig, Sighandler_t subcode)
1670{
3fadfdf1 1671 return win32_signal(sig, subcode);
7766f137
GS
1672}
1673
57ab3dfe
GS
1674int
1675PerlProcGetTimeOfDay(struct IPerlProc* piPerl, struct timeval *t, void *z)
1676{
1677 return win32_gettimeofday(t, z);
1678}
1679
8454a2ba 1680#ifdef USE_ITHREADS
c00206c8 1681static THREAD_RET_TYPE
7766f137
GS
1682win32_start_child(LPVOID arg)
1683{
1684 PerlInterpreter *my_perl = (PerlInterpreter*)arg;
7766f137 1685 int status;
aeecf691 1686 HWND parent_message_hwnd;
7766f137
GS
1687#ifdef PERL_SYNC_FORK
1688 static long sync_fork_id = 0;
1689 long id = ++sync_fork_id;
1690#endif
1691
1692
ba869deb 1693 PERL_SET_THX(my_perl);
222c300a 1694 win32_checkTLS(my_perl);
7766f137 1695
7766f137
GS
1696#ifdef PERL_SYNC_FORK
1697 w32_pseudo_id = id;
1698#else
1699 w32_pseudo_id = GetCurrentThreadId();
1700#endif
6a04c246 1701#ifdef PERL_USES_PL_PIDSTATUS
7766f137 1702 hv_clear(PL_pidstatus);
6a04c246 1703#endif
7766f137 1704
aeecf691
JD
1705 /* create message window and tell parent about it */
1706 parent_message_hwnd = w32_message_hwnd;
1707 w32_message_hwnd = win32_create_message_window();
1708 if (parent_message_hwnd != NULL)
fa58a56f 1709 PostMessage(parent_message_hwnd, WM_USER_MESSAGE, w32_pseudo_id, (LPARAM)w32_message_hwnd);
aeecf691 1710
7766f137
GS
1711 /* push a zero on the stack (we are the child) */
1712 {
39644a26 1713 dSP;
7766f137
GS
1714 dTARGET;
1715 PUSHi(0);
1716 PUTBACK;
1717 }
1718
1719 /* continue from next op */
1720 PL_op = PL_op->op_next;
1721
1722 {
1723 dJMPENV;
f90117a9 1724 volatile int oldscope = 1; /* We are responsible for all scopes */
7766f137
GS
1725
1726restart:
1727 JMPENV_PUSH(status);
1728 switch (status) {
1729 case 0:
1730 CALLRUNOPS(aTHX);
adab9969
JD
1731 /* We may have additional unclosed scopes if fork() was called
1732 * from within a BEGIN block. See perlfork.pod for more details.
1cb985b0
JD
1733 * We cannot clean up these other scopes because they belong to a
1734 * different interpreter, but we also cannot leave PL_scopestack_ix
1735 * dangling because that can trigger an assertion in perl_destruct().
adab9969 1736 */
1cb985b0
JD
1737 if (PL_scopestack_ix > oldscope) {
1738 PL_scopestack[oldscope-1] = PL_scopestack[PL_scopestack_ix-1];
1739 PL_scopestack_ix = oldscope;
1740 }
7766f137
GS
1741 status = 0;
1742 break;
1743 case 2:
1744 while (PL_scopestack_ix > oldscope)
1745 LEAVE;
1746 FREETMPS;
1747 PL_curstash = PL_defstash;
03d9f026
FC
1748 if (PL_curstash != PL_defstash) {
1749 SvREFCNT_dec(PL_curstash);
1750 PL_curstash = (HV *)SvREFCNT_inc(PL_defstash);
1751 }
49f9fecb
VP
1752 if (PL_endav && !PL_minus_c) {
1753 PERL_SET_PHASE(PERL_PHASE_END);
7766f137 1754 call_list(oldscope, PL_endav);
49f9fecb 1755 }
37038d91 1756 status = STATUS_EXIT;
7766f137
GS
1757 break;
1758 case 3:
1759 if (PL_restartop) {
1760 POPSTACK_TO(PL_mainstack);
1761 PL_op = PL_restartop;
bcabcc50 1762 PL_restartop = (OP*)NULL;
7766f137
GS
1763 goto restart;
1764 }
1765 PerlIO_printf(Perl_error_log, "panic: restartop\n");
1766 FREETMPS;
1767 status = 1;
1768 break;
1769 }
1770 JMPENV_POP;
1771
1772 /* XXX hack to avoid perl_destruct() freeing optree */
222c300a 1773 win32_checkTLS(my_perl);
bcabcc50 1774 PL_main_root = (OP*)NULL;
7766f137
GS
1775 }
1776
222c300a 1777 win32_checkTLS(my_perl);
1c0ca838
GS
1778 /* close the std handles to avoid fd leaks */
1779 {
8fde6460
CS
1780 do_close(PL_stdingv, FALSE);
1781 do_close(gv_fetchpv("STDOUT", TRUE, SVt_PVIO), FALSE); /* PL_stdoutgv - ISAGN */
1782 do_close(PL_stderrgv, FALSE);
1c0ca838
GS
1783 }
1784
7766f137 1785 /* destroy everything (waits for any pseudo-forked children) */
222c300a 1786 win32_checkTLS(my_perl);
7766f137 1787 perl_destruct(my_perl);
222c300a 1788 win32_checkTLS(my_perl);
7766f137
GS
1789 perl_free(my_perl);
1790
1791#ifdef PERL_SYNC_FORK
1792 return id;
1793#else
1794 return (DWORD)status;
1795#endif
1796}
8454a2ba 1797#endif /* USE_ITHREADS */
7766f137
GS
1798
1799int
1800PerlProcFork(struct IPerlProc* piPerl)
1801{
8454a2ba 1802#ifdef USE_ITHREADS
9399a70c 1803 dTHX;
7766f137
GS
1804 DWORD id;
1805 HANDLE handle;
7a955601
GS
1806 CPerlHost *h;
1807
1808 if (w32_num_pseudo_children >= MAXIMUM_WAIT_OBJECTS) {
1809 errno = EAGAIN;
1810 return -1;
1811 }
1812 h = new CPerlHost(*(CPerlHost*)w32_internal_host);
46a76da7 1813 PerlInterpreter *new_perl = perl_clone_using((PerlInterpreter*)aTHX,
682bcedc 1814 CLONEf_COPY_STACKS,
7766f137
GS
1815 h->m_pHostperlMem,
1816 h->m_pHostperlMemShared,
1817 h->m_pHostperlMemParse,
1818 h->m_pHostperlEnv,
1819 h->m_pHostperlStdIO,
1820 h->m_pHostperlLIO,
1821 h->m_pHostperlDir,
1822 h->m_pHostperlSock,
1823 h->m_pHostperlProc
1824 );
ad4e2db7 1825 new_perl->Isys_intern.internal_host = h;
222c300a 1826 h->host_perl = new_perl;
8454a2ba 1827# ifdef PERL_SYNC_FORK
7766f137 1828 id = win32_start_child((LPVOID)new_perl);
acfe0abc 1829 PERL_SET_THX(aTHX);
8454a2ba 1830# else
aeecf691
JD
1831 if (w32_message_hwnd == INVALID_HANDLE_VALUE)
1832 w32_message_hwnd = win32_create_message_window();
1833 new_perl->Isys_intern.message_hwnd = w32_message_hwnd;
1834 w32_pseudo_child_message_hwnds[w32_num_pseudo_children] =
777c9af2 1835 (w32_message_hwnd == NULL) ? (HWND)NULL : (HWND)INVALID_HANDLE_VALUE;
c00206c8
GS
1836# ifdef USE_RTL_THREAD_API
1837 handle = (HANDLE)_beginthreadex((void*)NULL, 0, win32_start_child,
1838 (void*)new_perl, 0, (unsigned*)&id);
1839# else
7766f137
GS
1840 handle = CreateThread(NULL, 0, win32_start_child,
1841 (LPVOID)new_perl, 0, &id);
c00206c8 1842# endif
acfe0abc 1843 PERL_SET_THX(aTHX); /* XXX perl_clone*() set TLS */
60fa28ff
GS
1844 if (!handle) {
1845 errno = EAGAIN;
1846 return -1;
1847 }
7766f137
GS
1848 w32_pseudo_child_handles[w32_num_pseudo_children] = handle;
1849 w32_pseudo_child_pids[w32_num_pseudo_children] = id;
8a3cb9c6 1850 w32_pseudo_child_sigterm[w32_num_pseudo_children] = 0;
7766f137 1851 ++w32_num_pseudo_children;
8454a2ba 1852# endif
7766f137 1853 return -(int)id;
8454a2ba 1854#else
073dd035 1855 win32_croak_not_implemented("fork()");
8454a2ba
GS
1856 return -1;
1857#endif /* USE_ITHREADS */
7766f137
GS
1858}
1859
1860int
1861PerlProcGetpid(struct IPerlProc* piPerl)
1862{
1863 return win32_getpid();
1864}
1865
1866void*
1867PerlProcDynaLoader(struct IPerlProc* piPerl, const char* filename)
1868{
1869 return win32_dynaload(filename);
1870}
1871
1872void
1873PerlProcGetOSError(struct IPerlProc* piPerl, SV* sv, DWORD dwErr)
1874{
1875 win32_str_os_error(sv, dwErr);
1876}
1877
7766f137
GS
1878int
1879PerlProcSpawnvp(struct IPerlProc* piPerl, int mode, const char *cmdname, const char *const *argv)
1880{
1881 return win32_spawnvp(mode, cmdname, argv);
1882}
1883
1884int
5f1a76d0
NIS
1885PerlProcLastHost(struct IPerlProc* piPerl)
1886{
dbf7dff6
DD
1887 /* this dTHX is unused in an optimized build since CPerlHost::num_hosts
1888 is a static */
acfe0abc 1889 dTHX;
5f1a76d0
NIS
1890 CPerlHost *h = (CPerlHost*)w32_internal_host;
1891 return h->LastHost();
1892}
1893
af2f850f 1894const struct IPerlProc perlProc =
7766f137
GS
1895{
1896 PerlProcAbort,
1897 PerlProcCrypt,
1898 PerlProcExit,
1899 PerlProc_Exit,
1900 PerlProcExecl,
1901 PerlProcExecv,
1902 PerlProcExecvp,
1903 PerlProcGetuid,
1904 PerlProcGeteuid,
1905 PerlProcGetgid,
1906 PerlProcGetegid,
1907 PerlProcGetlogin,
1908 PerlProcKill,
1909 PerlProcKillpg,
1910 PerlProcPauseProc,
1911 PerlProcPopen,
1912 PerlProcPclose,
1913 PerlProcPipe,
1914 PerlProcSetuid,
1915 PerlProcSetgid,
1916 PerlProcSleep,
1917 PerlProcTimes,
1918 PerlProcWait,
1919 PerlProcWaitpid,
1920 PerlProcSignal,
1921 PerlProcFork,
1922 PerlProcGetpid,
1923 PerlProcDynaLoader,
1924 PerlProcGetOSError,
7766f137 1925 PerlProcSpawnvp,
8c0134a8 1926 PerlProcLastHost,
57ab3dfe
GS
1927 PerlProcPopenList,
1928 PerlProcGetTimeOfDay
7766f137
GS
1929};
1930
1931
1932/*
1933 * CPerlHost
1934 */
1935
1936CPerlHost::CPerlHost(void)
1937{
5f1a76d0
NIS
1938 /* Construct a host from scratch */
1939 InterlockedIncrement(&num_hosts);
7766f137
GS
1940 m_pvDir = new VDir();
1941 m_pVMem = new VMem();
1942 m_pVMemShared = new VMem();
1943 m_pVMemParse = new VMem();
1944
1945 m_pvDir->Init(NULL, m_pVMem);
1946
1947 m_dwEnvCount = 0;
1948 m_lppEnvList = NULL;
85fdc8b6 1949 m_bTopLevel = TRUE;
7766f137
GS
1950
1951 CopyMemory(&m_hostperlMem, &perlMem, sizeof(perlMem));
1952 CopyMemory(&m_hostperlMemShared, &perlMemShared, sizeof(perlMemShared));
1953 CopyMemory(&m_hostperlMemParse, &perlMemParse, sizeof(perlMemParse));
1954 CopyMemory(&m_hostperlEnv, &perlEnv, sizeof(perlEnv));
1955 CopyMemory(&m_hostperlStdIO, &perlStdIO, sizeof(perlStdIO));
1956 CopyMemory(&m_hostperlLIO, &perlLIO, sizeof(perlLIO));
1957 CopyMemory(&m_hostperlDir, &perlDir, sizeof(perlDir));
1958 CopyMemory(&m_hostperlSock, &perlSock, sizeof(perlSock));
1959 CopyMemory(&m_hostperlProc, &perlProc, sizeof(perlProc));
1960
1961 m_pHostperlMem = &m_hostperlMem;
1962 m_pHostperlMemShared = &m_hostperlMemShared;
1963 m_pHostperlMemParse = &m_hostperlMemParse;
1964 m_pHostperlEnv = &m_hostperlEnv;
1965 m_pHostperlStdIO = &m_hostperlStdIO;
1966 m_pHostperlLIO = &m_hostperlLIO;
1967 m_pHostperlDir = &m_hostperlDir;
1968 m_pHostperlSock = &m_hostperlSock;
1969 m_pHostperlProc = &m_hostperlProc;
1970}
1971
1972#define SETUPEXCHANGE(xptr, iptr, table) \
1973 STMT_START { \
1974 if (xptr) { \
1975 iptr = *xptr; \
1976 *xptr = &table; \
1977 } \
1978 else { \
1979 iptr = &table; \
1980 } \
1981 } STMT_END
1982
1983CPerlHost::CPerlHost(struct IPerlMem** ppMem, struct IPerlMem** ppMemShared,
1984 struct IPerlMem** ppMemParse, struct IPerlEnv** ppEnv,
1985 struct IPerlStdIO** ppStdIO, struct IPerlLIO** ppLIO,
1986 struct IPerlDir** ppDir, struct IPerlSock** ppSock,
1987 struct IPerlProc** ppProc)
1988{
5f1a76d0 1989 InterlockedIncrement(&num_hosts);
f7aeb604 1990 m_pvDir = new VDir(0);
7766f137
GS
1991 m_pVMem = new VMem();
1992 m_pVMemShared = new VMem();
1993 m_pVMemParse = new VMem();
1994
1995 m_pvDir->Init(NULL, m_pVMem);
1996
1997 m_dwEnvCount = 0;
1998 m_lppEnvList = NULL;
85fdc8b6 1999 m_bTopLevel = FALSE;
7766f137
GS
2000
2001 CopyMemory(&m_hostperlMem, &perlMem, sizeof(perlMem));
2002 CopyMemory(&m_hostperlMemShared, &perlMemShared, sizeof(perlMemShared));
2003 CopyMemory(&m_hostperlMemParse, &perlMemParse, sizeof(perlMemParse));
2004 CopyMemory(&m_hostperlEnv, &perlEnv, sizeof(perlEnv));
2005 CopyMemory(&m_hostperlStdIO, &perlStdIO, sizeof(perlStdIO));
2006 CopyMemory(&m_hostperlLIO, &perlLIO, sizeof(perlLIO));
2007 CopyMemory(&m_hostperlDir, &perlDir, sizeof(perlDir));
2008 CopyMemory(&m_hostperlSock, &perlSock, sizeof(perlSock));
2009 CopyMemory(&m_hostperlProc, &perlProc, sizeof(perlProc));
2010
2011 SETUPEXCHANGE(ppMem, m_pHostperlMem, m_hostperlMem);
2012 SETUPEXCHANGE(ppMemShared, m_pHostperlMemShared, m_hostperlMemShared);
2013 SETUPEXCHANGE(ppMemParse, m_pHostperlMemParse, m_hostperlMemParse);
2014 SETUPEXCHANGE(ppEnv, m_pHostperlEnv, m_hostperlEnv);
2015 SETUPEXCHANGE(ppStdIO, m_pHostperlStdIO, m_hostperlStdIO);
2016 SETUPEXCHANGE(ppLIO, m_pHostperlLIO, m_hostperlLIO);
2017 SETUPEXCHANGE(ppDir, m_pHostperlDir, m_hostperlDir);
2018 SETUPEXCHANGE(ppSock, m_pHostperlSock, m_hostperlSock);
2019 SETUPEXCHANGE(ppProc, m_pHostperlProc, m_hostperlProc);
2020}
2021#undef SETUPEXCHANGE
2022
2023CPerlHost::CPerlHost(CPerlHost& host)
2024{
5f1a76d0
NIS
2025 /* Construct a host from another host */
2026 InterlockedIncrement(&num_hosts);
7766f137
GS
2027 m_pVMem = new VMem();
2028 m_pVMemShared = host.GetMemShared();
2029 m_pVMemParse = host.GetMemParse();
2030
2031 /* duplicate directory info */
f7aeb604 2032 m_pvDir = new VDir(0);
7766f137
GS
2033 m_pvDir->Init(host.GetDir(), m_pVMem);
2034
2035 CopyMemory(&m_hostperlMem, &perlMem, sizeof(perlMem));
2036 CopyMemory(&m_hostperlMemShared, &perlMemShared, sizeof(perlMemShared));
2037 CopyMemory(&m_hostperlMemParse, &perlMemParse, sizeof(perlMemParse));
2038 CopyMemory(&m_hostperlEnv, &perlEnv, sizeof(perlEnv));
2039 CopyMemory(&m_hostperlStdIO, &perlStdIO, sizeof(perlStdIO));
2040 CopyMemory(&m_hostperlLIO, &perlLIO, sizeof(perlLIO));
2041 CopyMemory(&m_hostperlDir, &perlDir, sizeof(perlDir));
2042 CopyMemory(&m_hostperlSock, &perlSock, sizeof(perlSock));
2043 CopyMemory(&m_hostperlProc, &perlProc, sizeof(perlProc));
ad4e2db7
GS
2044 m_pHostperlMem = &m_hostperlMem;
2045 m_pHostperlMemShared = &m_hostperlMemShared;
2046 m_pHostperlMemParse = &m_hostperlMemParse;
2047 m_pHostperlEnv = &m_hostperlEnv;
2048 m_pHostperlStdIO = &m_hostperlStdIO;
2049 m_pHostperlLIO = &m_hostperlLIO;
2050 m_pHostperlDir = &m_hostperlDir;
2051 m_pHostperlSock = &m_hostperlSock;
2052 m_pHostperlProc = &m_hostperlProc;
7766f137
GS
2053
2054 m_dwEnvCount = 0;
2055 m_lppEnvList = NULL;
85fdc8b6 2056 m_bTopLevel = FALSE;
7766f137
GS
2057
2058 /* duplicate environment info */
2059 LPSTR lpPtr;
2060 DWORD dwIndex = 0;
2061 while(lpPtr = host.GetIndex(dwIndex))
2062 Add(lpPtr);
2063}
2064
2065CPerlHost::~CPerlHost(void)
2066{
2b93cd4d 2067 Reset();
5f1a76d0 2068 InterlockedDecrement(&num_hosts);
7766f137
GS
2069 delete m_pvDir;
2070 m_pVMemParse->Release();
2071 m_pVMemShared->Release();
2072 m_pVMem->Release();
2073}
2074
2075LPSTR
2076CPerlHost::Find(LPCSTR lpStr)
2077{
2078 LPSTR lpPtr;
2079 LPSTR* lppPtr = Lookup(lpStr);
2080 if(lppPtr != NULL) {
2081 for(lpPtr = *lppPtr; *lpPtr != '\0' && *lpPtr != '='; ++lpPtr)
2082 ;
2083
2084 if(*lpPtr == '=')
2085 ++lpPtr;
2086
2087 return lpPtr;
2088 }
2089 return NULL;
2090}
2091
2092int
2093lookup(const void *arg1, const void *arg2)
52cbf511 2094{ // Compare strings
7766f137
GS
2095 char*ptr1, *ptr2;
2096 char c1,c2;
2097
2098 ptr1 = *(char**)arg1;
2099 ptr2 = *(char**)arg2;
2100 for(;;) {
2101 c1 = *ptr1++;
2102 c2 = *ptr2++;
2103 if(c1 == '\0' || c1 == '=') {
2104 if(c2 == '\0' || c2 == '=')
2105 break;
2106
52cbf511 2107 return -1; // string 1 < string 2
7766f137
GS
2108 }
2109 else if(c2 == '\0' || c2 == '=')
52cbf511 2110 return 1; // string 1 > string 2
7766f137
GS
2111 else if(c1 != c2) {
2112 c1 = toupper(c1);
2113 c2 = toupper(c2);
2114 if(c1 != c2) {
2115 if(c1 < c2)
52cbf511 2116 return -1; // string 1 < string 2
7766f137 2117
52cbf511 2118 return 1; // string 1 > string 2
7766f137
GS
2119 }
2120 }
2121 }
2122 return 0;
2123}
2124
2125LPSTR*
2126CPerlHost::Lookup(LPCSTR lpStr)
2127{
2b93cd4d
GS
2128 if (!lpStr)
2129 return NULL;
7766f137
GS
2130 return (LPSTR*)bsearch(&lpStr, m_lppEnvList, m_dwEnvCount, sizeof(LPSTR), lookup);
2131}
2132
2133int
2134compare(const void *arg1, const void *arg2)
52cbf511 2135{ // Compare strings
7766f137
GS
2136 char*ptr1, *ptr2;
2137 char c1,c2;
2138
2139 ptr1 = *(char**)arg1;
2140 ptr2 = *(char**)arg2;
2141 for(;;) {
2142 c1 = *ptr1++;
2143 c2 = *ptr2++;
2144 if(c1 == '\0' || c1 == '=') {
2145 if(c1 == c2)
2146 break;
2147
52cbf511 2148 return -1; // string 1 < string 2
7766f137
GS
2149 }
2150 else if(c2 == '\0' || c2 == '=')
52cbf511 2151 return 1; // string 1 > string 2
7766f137
GS
2152 else if(c1 != c2) {
2153 c1 = toupper(c1);
2154 c2 = toupper(c2);
2155 if(c1 != c2) {
2156 if(c1 < c2)
52cbf511 2157 return -1; // string 1 < string 2
3fadfdf1 2158
52cbf511 2159 return 1; // string 1 > string 2
7766f137
GS
2160 }
2161 }
2162 }
2163 return 0;
2164}
2165
2166void
2167CPerlHost::Add(LPCSTR lpStr)
2168{
7766f137 2169 LPSTR *lpPtr;
8586647e 2170 STRLEN length = strlen(lpStr)+1;
7766f137 2171
52cbf511 2172 // replacing ?
8586647e 2173 lpPtr = Lookup(lpStr);
2b93cd4d
GS
2174 if (lpPtr != NULL) {
2175 // must allocate things via host memory allocation functions
2176 // rather than perl's Renew() et al, as the perl interpreter
2177 // may either not be initialized enough when we allocate these,
2178 // or may already be dead when we go to free these
2179 *lpPtr = (char*)Realloc(*lpPtr, length * sizeof(char));
7766f137
GS
2180 strcpy(*lpPtr, lpStr);
2181 }
2182 else {
2b93cd4d
GS
2183 m_lppEnvList = (LPSTR*)Realloc(m_lppEnvList, (m_dwEnvCount+1) * sizeof(LPSTR));
2184 if (m_lppEnvList) {
2185 m_lppEnvList[m_dwEnvCount] = (char*)Malloc(length * sizeof(char));
2186 if (m_lppEnvList[m_dwEnvCount] != NULL) {
2187 strcpy(m_lppEnvList[m_dwEnvCount], lpStr);
2188 ++m_dwEnvCount;
2189 qsort(m_lppEnvList, m_dwEnvCount, sizeof(LPSTR), compare);
2190 }
7766f137 2191 }
7766f137
GS
2192 }
2193}
2194
2195DWORD
2196CPerlHost::CalculateEnvironmentSpace(void)
2197{
2198 DWORD index;
2199 DWORD dwSize = 0;
2200 for(index = 0; index < m_dwEnvCount; ++index)
2201 dwSize += strlen(m_lppEnvList[index]) + 1;
2202
2203 return dwSize;
2204}
2205
2206void
2207CPerlHost::FreeLocalEnvironmentStrings(LPSTR lpStr)
2208{
7766f137
GS
2209 Safefree(lpStr);
2210}
2211
2212char*
2213CPerlHost::GetChildDir(void)
2214{
7766f137 2215 char* ptr;
d684b162
JD
2216 size_t length;
2217
aa2b96ec
JD
2218 Newx(ptr, MAX_PATH+1, char);
2219 m_pvDir->GetCurrentDirectoryA(MAX_PATH+1, ptr);
d684b162
JD
2220 length = strlen(ptr);
2221 if (length > 3) {
2222 if ((ptr[length-1] == '\\') || (ptr[length-1] == '/'))
2223 ptr[length-1] = 0;
7766f137
GS
2224 }
2225 return ptr;
2226}
2227
2228void
2229CPerlHost::FreeChildDir(char* pStr)
2230{
7766f137
GS
2231 Safefree(pStr);
2232}
2233
2234LPSTR
2235CPerlHost::CreateLocalEnvironmentStrings(VDir &vDir)
2236{
7766f137
GS
2237 LPSTR lpStr, lpPtr, lpEnvPtr, lpTmp, lpLocalEnv, lpAllocPtr;
2238 DWORD dwSize, dwEnvIndex;
2239 int nLength, compVal;
2240
52cbf511 2241 // get the process environment strings
4f46e52b 2242 lpAllocPtr = lpTmp = (LPSTR)win32_getenvironmentstrings();
7766f137 2243
52cbf511 2244 // step over current directory stuff
7766f137
GS
2245 while(*lpTmp == '=')
2246 lpTmp += strlen(lpTmp) + 1;
2247
52cbf511 2248 // save the start of the environment strings
7766f137
GS
2249 lpEnvPtr = lpTmp;
2250 for(dwSize = 1; *lpTmp != '\0'; lpTmp += strlen(lpTmp) + 1) {
52cbf511 2251 // calculate the size of the environment strings
7766f137
GS
2252 dwSize += strlen(lpTmp) + 1;
2253 }
2254
52cbf511 2255 // add the size of current directories
7766f137
GS
2256 dwSize += vDir.CalculateEnvironmentSpace();
2257
52cbf511 2258 // add the additional space used by changes made to the environment
7766f137
GS
2259 dwSize += CalculateEnvironmentSpace();
2260
a02a5408 2261 Newx(lpStr, dwSize, char);
7766f137
GS
2262 lpPtr = lpStr;
2263 if(lpStr != NULL) {
52cbf511 2264 // build the local environment
7766f137
GS
2265 lpStr = vDir.BuildEnvironmentSpace(lpStr);
2266
2267 dwEnvIndex = 0;
2268 lpLocalEnv = GetIndex(dwEnvIndex);
2269 while(*lpEnvPtr != '\0') {
ec00bdd8 2270 if(!lpLocalEnv) {
52cbf511
JH
2271 // all environment overrides have been added
2272 // so copy string into place
7766f137
GS
2273 strcpy(lpStr, lpEnvPtr);
2274 nLength = strlen(lpEnvPtr) + 1;
2275 lpStr += nLength;
2276 lpEnvPtr += nLength;
2277 }
3fadfdf1 2278 else {
52cbf511 2279 // determine which string to copy next
7766f137
GS
2280 compVal = compare(&lpEnvPtr, &lpLocalEnv);
2281 if(compVal < 0) {
2282 strcpy(lpStr, lpEnvPtr);
2283 nLength = strlen(lpEnvPtr) + 1;
2284 lpStr += nLength;
2285 lpEnvPtr += nLength;
2286 }
2287 else {
2288 char *ptr = strchr(lpLocalEnv, '=');
2289 if(ptr && ptr[1]) {
2290 strcpy(lpStr, lpLocalEnv);
2291 lpStr += strlen(lpLocalEnv) + 1;
2292 }
2293 lpLocalEnv = GetIndex(dwEnvIndex);
2294 if(compVal == 0) {
52cbf511 2295 // this string was replaced
7766f137
GS
2296 lpEnvPtr += strlen(lpEnvPtr) + 1;
2297 }
2298 }
2299 }
2300 }
2301
ec00bdd8 2302 while(lpLocalEnv) {
52cbf511
JH
2303 // still have environment overrides to add
2304 // so copy the strings into place if not an override
1784c7b8
JH
2305 char *ptr = strchr(lpLocalEnv, '=');
2306 if(ptr && ptr[1]) {
2307 strcpy(lpStr, lpLocalEnv);
2308 lpStr += strlen(lpLocalEnv) + 1;
2309 }
ec00bdd8
GS
2310 lpLocalEnv = GetIndex(dwEnvIndex);
2311 }
2312
52cbf511 2313 // add final NULL
7766f137
GS
2314 *lpStr = '\0';
2315 }
2316
52cbf511 2317 // release the process environment strings
4f46e52b 2318 win32_freeenvironmentstrings(lpAllocPtr);
7766f137
GS
2319
2320 return lpPtr;
2321}
2322
2323void
2324CPerlHost::Reset(void)
2325{
7766f137
GS
2326 if(m_lppEnvList != NULL) {
2327 for(DWORD index = 0; index < m_dwEnvCount; ++index) {
2b93cd4d 2328 Free(m_lppEnvList[index]);
7766f137
GS
2329 m_lppEnvList[index] = NULL;
2330 }
2331 }
2332 m_dwEnvCount = 0;
2b93cd4d
GS
2333 Free(m_lppEnvList);
2334 m_lppEnvList = NULL;
7766f137
GS
2335}
2336
2337void
2338CPerlHost::Clearenv(void)
2339{
2340 char ch;
2341 LPSTR lpPtr, lpStr, lpEnvPtr;
2fb9ab56 2342 if (m_lppEnvList != NULL) {
7766f137
GS
2343 /* set every entry to an empty string */
2344 for(DWORD index = 0; index < m_dwEnvCount; ++index) {
2345 char* ptr = strchr(m_lppEnvList[index], '=');
2346 if(ptr) {
2347 *++ptr = 0;
2348 }
2349 }
2350 }
2351
2352 /* get the process environment strings */
4f46e52b 2353 lpStr = lpEnvPtr = (LPSTR)win32_getenvironmentstrings();
7766f137
GS
2354
2355 /* step over current directory stuff */
2356 while(*lpStr == '=')
2357 lpStr += strlen(lpStr) + 1;
2358
2359 while(*lpStr) {
2360 lpPtr = strchr(lpStr, '=');
2361 if(lpPtr) {
2362 ch = *++lpPtr;
2363 *lpPtr = 0;
2364 Add(lpStr);
85fdc8b6 2365 if (m_bTopLevel)
2fb9ab56 2366 (void)win32_putenv(lpStr);
7766f137
GS
2367 *lpPtr = ch;
2368 }
2369 lpStr += strlen(lpStr) + 1;
2370 }
2371
4f46e52b 2372 win32_freeenvironmentstrings(lpEnvPtr);
7766f137
GS
2373}
2374
2375
2376char*
2377CPerlHost::Getenv(const char *varname)
2378{
85fdc8b6 2379 if (!m_bTopLevel) {
2fb9ab56 2380 char *pEnv = Find(varname);
4354e59a 2381 if (pEnv && *pEnv)
2fb9ab56 2382 return pEnv;
7766f137 2383 }
2fb9ab56 2384 return win32_getenv(varname);
7766f137
GS
2385}
2386
2387int
2388CPerlHost::Putenv(const char *envstring)
2389{
2390 Add(envstring);
85fdc8b6 2391 if (m_bTopLevel)
2fb9ab56
NIS
2392 return win32_putenv(envstring);
2393
7766f137
GS
2394 return 0;
2395}
2396
2397int
2398CPerlHost::Chdir(const char *dirname)
2399{
7766f137 2400 int ret;
9ec3348a
JH
2401 if (!dirname) {
2402 errno = ENOENT;
2403 return -1;
2404 }
8c56068e 2405 ret = m_pvDir->SetCurrentDirectoryA((char*)dirname);
7766f137
GS
2406 if(ret < 0) {
2407 errno = ENOENT;
2408 }
2409 return ret;
2410}
2411
2412#endif /* ___PerlHost_H___ */