This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Bump Data::Dumper version
[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,
1604cfb0
MS
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);
7766f137
GS
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 {
1604cfb0
MS
64 size_t count = num*size;
65 void* lpVoid = Malloc(count);
66 if (lpVoid)
67 ZeroMemory(lpVoid, count);
68 return lpVoid;
7766f137
GS
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 {
1604cfb0
MS
81 void *result;
82 GetLockShared();
83 result = m_pVMemShared->Malloc(size);
84 FreeLockShared();
85 return result;
f3dccfae
NIS
86 };
87 inline void* ReallocShared(void* ptr, size_t size)
88 {
1604cfb0
MS
89 void *result;
90 GetLockShared();
91 result = m_pVMemShared->Realloc(ptr, size);
92 FreeLockShared();
93 return result;
f3dccfae
NIS
94 };
95 inline void FreeShared(void* ptr)
96 {
1604cfb0
MS
97 GetLockShared();
98 m_pVMemShared->Free(ptr);
99 FreeLockShared();
7766f137 100 };
7766f137
GS
101 inline void* CallocShared(size_t num, size_t size)
102 {
1604cfb0
MS
103 size_t count = num*size;
104 void* lpVoid = MallocShared(count);
105 if (lpVoid)
106 ZeroMemory(lpVoid, count);
107 return lpVoid;
7766f137 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 {
1604cfb0
MS
122 size_t count = num*size;
123 void* lpVoid = MallocParse(count);
124 if (lpVoid)
125 ZeroMemory(lpVoid, count);
126 return lpVoid;
7766f137 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 {
1604cfb0
MS
134 *len = 0;
135 char *e = Getenv(varname);
136 if (e)
137 *len = strlen(e);
138 return e;
7766f137
GS
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 {
1604cfb0
MS
149 if(dwIndex < m_dwEnvCount)
150 {
151 ++dwIndex;
152 return m_lppEnvList[dwIndex-1];
153 }
154 return NULL;
7766f137
GS
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 526PerlEnvVendorLibPath(struct IPerlEnv* piPerl, const char *pl,
1604cfb0 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) {
1604cfb0
MS
836 mode[0] = 'r';
837 mode[1] = 0;
7766f137 838 }
1f664ef5 839 else if (PERLIO_FILE_flag(pf) & PERLIO_FILE_flag_WR) {
1604cfb0
MS
840 mode[0] = 'a';
841 mode[1] = 0;
7766f137 842 }
1f664ef5 843 else if (PERLIO_FILE_flag(pf) & PERLIO_FILE_flag_RW) {
1604cfb0
MS
844 mode[0] = 'r';
845 mode[1] = '+';
846 mode[2] = 0;
7766f137
GS
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 856 if (!fgetpos(pf, &pos)) {
1604cfb0 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
680b2c5e
TC
989int
990PerlLIOSymLink(struct IPerlLIO* piPerl, const char*oldname, const char *newname)
991{
992 return win32_symlink(oldname, newname);
993}
994
995int
996PerlLIOReadLink(struct IPerlLIO* piPerl, const char *path, char *buf, size_t bufsiz)
997{
998 return win32_readlink(path, buf, bufsiz);
999}
1000
c623ac67
GS
1001Off_t
1002PerlLIOLseek(struct IPerlLIO* piPerl, int handle, Off_t offset, int origin)
7766f137
GS
1003{
1004 return win32_lseek(handle, offset, origin);
1005}
1006
1007int
c623ac67 1008PerlLIOLstat(struct IPerlLIO* piPerl, const char *path, Stat_t *buffer)
7766f137 1009{
92b3a3eb 1010 return win32_lstat(path, buffer);
7766f137
GS
1011}
1012
1013char*
1014PerlLIOMktemp(struct IPerlLIO* piPerl, char *Template)
1015{
1016 return mktemp(Template);
1017}
1018
1019int
1020PerlLIOOpen(struct IPerlLIO* piPerl, const char *filename, int oflag)
1021{
1022 return win32_open(filename, oflag);
1023}
1024
1025int
1026PerlLIOOpen3(struct IPerlLIO* piPerl, const char *filename, int oflag, int pmode)
1027{
1028 return win32_open(filename, oflag, pmode);
1029}
1030
1031int
1032PerlLIORead(struct IPerlLIO* piPerl, int handle, void *buffer, unsigned int count)
1033{
1034 return win32_read(handle, buffer, count);
1035}
1036
1037int
1038PerlLIORename(struct IPerlLIO* piPerl, const char *OldFileName, const char *newname)
1039{
1040 return win32_rename(OldFileName, newname);
1041}
1042
1043int
1044PerlLIOSetmode(struct IPerlLIO* piPerl, int handle, int mode)
1045{
1046 return win32_setmode(handle, mode);
1047}
1048
1049int
c623ac67 1050PerlLIONameStat(struct IPerlLIO* piPerl, const char *path, Stat_t *buffer)
7766f137
GS
1051{
1052 return win32_stat(path, buffer);
1053}
1054
1055char*
1056PerlLIOTmpnam(struct IPerlLIO* piPerl, char *string)
1057{
1058 return tmpnam(string);
1059}
1060
1061int
1062PerlLIOUmask(struct IPerlLIO* piPerl, int pmode)
1063{
1064 return umask(pmode);
1065}
1066
1067int
1068PerlLIOUnlink(struct IPerlLIO* piPerl, const char *filename)
1069{
1070 return win32_unlink(filename);
1071}
1072
1073int
c3ff6b30 1074PerlLIOUtime(struct IPerlLIO* piPerl, const char *filename, struct utimbuf *times)
7766f137
GS
1075{
1076 return win32_utime(filename, times);
1077}
1078
1079int
1080PerlLIOWrite(struct IPerlLIO* piPerl, int handle, const void *buffer, unsigned int count)
1081{
1082 return win32_write(handle, buffer, count);
1083}
1084
af2f850f 1085const struct IPerlLIO perlLIO =
7766f137
GS
1086{
1087 PerlLIOAccess,
1088 PerlLIOChmod,
1089 PerlLIOChown,
1090 PerlLIOChsize,
1091 PerlLIOClose,
1092 PerlLIODup,
1093 PerlLIODup2,
1094 PerlLIOFlock,
1095 PerlLIOFileStat,
1096 PerlLIOIOCtl,
1097 PerlLIOIsatty,
1098 PerlLIOLink,
1099 PerlLIOLseek,
1100 PerlLIOLstat,
1101 PerlLIOMktemp,
1102 PerlLIOOpen,
1103 PerlLIOOpen3,
1104 PerlLIORead,
1105 PerlLIORename,
1106 PerlLIOSetmode,
1107 PerlLIONameStat,
1108 PerlLIOTmpnam,
1109 PerlLIOUmask,
1110 PerlLIOUnlink,
1111 PerlLIOUtime,
1112 PerlLIOWrite,
680b2c5e
TC
1113 PerlLIOSymLink,
1114 PerlLIOReadLink
7766f137
GS
1115};
1116
1117
1118#undef IPERL2HOST
1119#define IPERL2HOST(x) IPerlDir2Host(x)
1120
1121/* IPerlDIR */
1122int
1123PerlDirMakedir(struct IPerlDir* piPerl, const char *dirname, int mode)
1124{
1125 return win32_mkdir(dirname, mode);
1126}
1127
1128int
1129PerlDirChdir(struct IPerlDir* piPerl, const char *dirname)
1130{
1131 return IPERL2HOST(piPerl)->Chdir(dirname);
1132}
1133
1134int
1135PerlDirRmdir(struct IPerlDir* piPerl, const char *dirname)
1136{
1137 return win32_rmdir(dirname);
1138}
1139
1140int
1141PerlDirClose(struct IPerlDir* piPerl, DIR *dirp)
1142{
1143 return win32_closedir(dirp);
1144}
1145
1146DIR*
0e06f75d 1147PerlDirOpen(struct IPerlDir* piPerl, const char *filename)
7766f137
GS
1148{
1149 return win32_opendir(filename);
1150}
1151
1152struct direct *
1153PerlDirRead(struct IPerlDir* piPerl, DIR *dirp)
1154{
1155 return win32_readdir(dirp);
1156}
1157
1158void
1159PerlDirRewind(struct IPerlDir* piPerl, DIR *dirp)
1160{
1161 win32_rewinddir(dirp);
1162}
1163
1164void
1165PerlDirSeek(struct IPerlDir* piPerl, DIR *dirp, long loc)
1166{
1167 win32_seekdir(dirp, loc);
1168}
1169
1170long
1171PerlDirTell(struct IPerlDir* piPerl, DIR *dirp)
1172{
1173 return win32_telldir(dirp);
1174}
1175
1176char*
1177PerlDirMapPathA(struct IPerlDir* piPerl, const char* path)
1178{
1179 return IPERL2HOST(piPerl)->MapPathA(path);
1180}
1181
1182WCHAR*
1183PerlDirMapPathW(struct IPerlDir* piPerl, const WCHAR* path)
1184{
1185 return IPERL2HOST(piPerl)->MapPathW(path);
1186}
1187
af2f850f 1188const struct IPerlDir perlDir =
7766f137
GS
1189{
1190 PerlDirMakedir,
1191 PerlDirChdir,
1192 PerlDirRmdir,
1193 PerlDirClose,
1194 PerlDirOpen,
1195 PerlDirRead,
1196 PerlDirRewind,
1197 PerlDirSeek,
1198 PerlDirTell,
1199 PerlDirMapPathA,
1200 PerlDirMapPathW,
1201};
1202
1203
1204/* IPerlSock */
1205u_long
1206PerlSockHtonl(struct IPerlSock* piPerl, u_long hostlong)
1207{
1208 return win32_htonl(hostlong);
1209}
1210
1211u_short
1212PerlSockHtons(struct IPerlSock* piPerl, u_short hostshort)
1213{
1214 return win32_htons(hostshort);
1215}
1216
1217u_long
1218PerlSockNtohl(struct IPerlSock* piPerl, u_long netlong)
1219{
1220 return win32_ntohl(netlong);
1221}
1222
1223u_short
1224PerlSockNtohs(struct IPerlSock* piPerl, u_short netshort)
1225{
1226 return win32_ntohs(netshort);
1227}
1228
1229SOCKET PerlSockAccept(struct IPerlSock* piPerl, SOCKET s, struct sockaddr* addr, int* addrlen)
1230{
1231 return win32_accept(s, addr, addrlen);
1232}
1233
1234int
1235PerlSockBind(struct IPerlSock* piPerl, SOCKET s, const struct sockaddr* name, int namelen)
1236{
1237 return win32_bind(s, name, namelen);
1238}
1239
1240int
1241PerlSockConnect(struct IPerlSock* piPerl, SOCKET s, const struct sockaddr* name, int namelen)
1242{
1243 return win32_connect(s, name, namelen);
1244}
1245
1246void
1247PerlSockEndhostent(struct IPerlSock* piPerl)
1248{
1249 win32_endhostent();
1250}
1251
1252void
1253PerlSockEndnetent(struct IPerlSock* piPerl)
1254{
1255 win32_endnetent();
1256}
1257
1258void
1259PerlSockEndprotoent(struct IPerlSock* piPerl)
1260{
1261 win32_endprotoent();
1262}
1263
1264void
1265PerlSockEndservent(struct IPerlSock* piPerl)
1266{
1267 win32_endservent();
1268}
1269
1270struct hostent*
1271PerlSockGethostbyaddr(struct IPerlSock* piPerl, const char* addr, int len, int type)
1272{
1273 return win32_gethostbyaddr(addr, len, type);
1274}
1275
1276struct hostent*
1277PerlSockGethostbyname(struct IPerlSock* piPerl, const char* name)
1278{
1279 return win32_gethostbyname(name);
1280}
1281
1282struct hostent*
1283PerlSockGethostent(struct IPerlSock* piPerl)
1284{
073dd035 1285 win32_croak_not_implemented("gethostent");
7766f137
GS
1286 return NULL;
1287}
1288
1289int
1290PerlSockGethostname(struct IPerlSock* piPerl, char* name, int namelen)
1291{
1292 return win32_gethostname(name, namelen);
1293}
1294
1295struct netent *
1296PerlSockGetnetbyaddr(struct IPerlSock* piPerl, long net, int type)
1297{
1298 return win32_getnetbyaddr(net, type);
1299}
1300
1301struct netent *
1302PerlSockGetnetbyname(struct IPerlSock* piPerl, const char *name)
1303{
1304 return win32_getnetbyname((char*)name);
1305}
1306
1307struct netent *
1308PerlSockGetnetent(struct IPerlSock* piPerl)
1309{
1310 return win32_getnetent();
1311}
1312
1313int PerlSockGetpeername(struct IPerlSock* piPerl, SOCKET s, struct sockaddr* name, int* namelen)
1314{
1315 return win32_getpeername(s, name, namelen);
1316}
1317
1318struct protoent*
1319PerlSockGetprotobyname(struct IPerlSock* piPerl, const char* name)
1320{
1321 return win32_getprotobyname(name);
1322}
1323
1324struct protoent*
1325PerlSockGetprotobynumber(struct IPerlSock* piPerl, int number)
1326{
1327 return win32_getprotobynumber(number);
1328}
1329
1330struct protoent*
1331PerlSockGetprotoent(struct IPerlSock* piPerl)
1332{
1333 return win32_getprotoent();
1334}
1335
1336struct servent*
1337PerlSockGetservbyname(struct IPerlSock* piPerl, const char* name, const char* proto)
1338{
1339 return win32_getservbyname(name, proto);
1340}
1341
1342struct servent*
1343PerlSockGetservbyport(struct IPerlSock* piPerl, int port, const char* proto)
1344{
1345 return win32_getservbyport(port, proto);
1346}
1347
1348struct servent*
1349PerlSockGetservent(struct IPerlSock* piPerl)
1350{
1351 return win32_getservent();
1352}
1353
1354int
1355PerlSockGetsockname(struct IPerlSock* piPerl, SOCKET s, struct sockaddr* name, int* namelen)
1356{
1357 return win32_getsockname(s, name, namelen);
1358}
1359
1360int
1361PerlSockGetsockopt(struct IPerlSock* piPerl, SOCKET s, int level, int optname, char* optval, int* optlen)
1362{
1363 return win32_getsockopt(s, level, optname, optval, optlen);
1364}
1365
1366unsigned long
1367PerlSockInetAddr(struct IPerlSock* piPerl, const char* cp)
1368{
1369 return win32_inet_addr(cp);
1370}
1371
1372char*
1373PerlSockInetNtoa(struct IPerlSock* piPerl, struct in_addr in)
1374{
1375 return win32_inet_ntoa(in);
1376}
1377
1378int
1379PerlSockListen(struct IPerlSock* piPerl, SOCKET s, int backlog)
1380{
1381 return win32_listen(s, backlog);
1382}
1383
1384int
1385PerlSockRecv(struct IPerlSock* piPerl, SOCKET s, char* buffer, int len, int flags)
1386{
1387 return win32_recv(s, buffer, len, flags);
1388}
1389
1390int
1391PerlSockRecvfrom(struct IPerlSock* piPerl, SOCKET s, char* buffer, int len, int flags, struct sockaddr* from, int* fromlen)
1392{
1393 return win32_recvfrom(s, buffer, len, flags, from, fromlen);
1394}
1395
1396int
1397PerlSockSelect(struct IPerlSock* piPerl, int nfds, char* readfds, char* writefds, char* exceptfds, const struct timeval* timeout)
1398{
1399 return win32_select(nfds, (Perl_fd_set*)readfds, (Perl_fd_set*)writefds, (Perl_fd_set*)exceptfds, timeout);
1400}
1401
1402int
1403PerlSockSend(struct IPerlSock* piPerl, SOCKET s, const char* buffer, int len, int flags)
1404{
1405 return win32_send(s, buffer, len, flags);
1406}
1407
1408int
1409PerlSockSendto(struct IPerlSock* piPerl, SOCKET s, const char* buffer, int len, int flags, const struct sockaddr* to, int tolen)
1410{
1411 return win32_sendto(s, buffer, len, flags, to, tolen);
1412}
1413
1414void
1415PerlSockSethostent(struct IPerlSock* piPerl, int stayopen)
1416{
1417 win32_sethostent(stayopen);
1418}
1419
1420void
1421PerlSockSetnetent(struct IPerlSock* piPerl, int stayopen)
1422{
1423 win32_setnetent(stayopen);
1424}
1425
1426void
1427PerlSockSetprotoent(struct IPerlSock* piPerl, int stayopen)
1428{
1429 win32_setprotoent(stayopen);
1430}
1431
1432void
1433PerlSockSetservent(struct IPerlSock* piPerl, int stayopen)
1434{
1435 win32_setservent(stayopen);
1436}
1437
1438int
1439PerlSockSetsockopt(struct IPerlSock* piPerl, SOCKET s, int level, int optname, const char* optval, int optlen)
1440{
1441 return win32_setsockopt(s, level, optname, optval, optlen);
1442}
1443
1444int
1445PerlSockShutdown(struct IPerlSock* piPerl, SOCKET s, int how)
1446{
1447 return win32_shutdown(s, how);
1448}
1449
1450SOCKET
1451PerlSockSocket(struct IPerlSock* piPerl, int af, int type, int protocol)
1452{
1453 return win32_socket(af, type, protocol);
1454}
1455
1456int
1457PerlSockSocketpair(struct IPerlSock* piPerl, int domain, int type, int protocol, int* fds)
1458{
e10bb1e9 1459 return Perl_my_socketpair(domain, type, protocol, fds);
7766f137
GS
1460}
1461
1462int
1463PerlSockClosesocket(struct IPerlSock* piPerl, SOCKET s)
1464{
1465 return win32_closesocket(s);
1466}
1467
1468int
1469PerlSockIoctlsocket(struct IPerlSock* piPerl, SOCKET s, long cmd, u_long *argp)
1470{
1471 return win32_ioctlsocket(s, cmd, argp);
1472}
1473
af2f850f 1474const struct IPerlSock perlSock =
7766f137
GS
1475{
1476 PerlSockHtonl,
1477 PerlSockHtons,
1478 PerlSockNtohl,
1479 PerlSockNtohs,
1480 PerlSockAccept,
1481 PerlSockBind,
1482 PerlSockConnect,
1483 PerlSockEndhostent,
1484 PerlSockEndnetent,
1485 PerlSockEndprotoent,
1486 PerlSockEndservent,
1487 PerlSockGethostname,
1488 PerlSockGetpeername,
1489 PerlSockGethostbyaddr,
1490 PerlSockGethostbyname,
1491 PerlSockGethostent,
1492 PerlSockGetnetbyaddr,
1493 PerlSockGetnetbyname,
1494 PerlSockGetnetent,
1495 PerlSockGetprotobyname,
1496 PerlSockGetprotobynumber,
1497 PerlSockGetprotoent,
1498 PerlSockGetservbyname,
1499 PerlSockGetservbyport,
1500 PerlSockGetservent,
1501 PerlSockGetsockname,
1502 PerlSockGetsockopt,
1503 PerlSockInetAddr,
1504 PerlSockInetNtoa,
1505 PerlSockListen,
1506 PerlSockRecv,
1507 PerlSockRecvfrom,
1508 PerlSockSelect,
1509 PerlSockSend,
1510 PerlSockSendto,
1511 PerlSockSethostent,
1512 PerlSockSetnetent,
1513 PerlSockSetprotoent,
1514 PerlSockSetservent,
1515 PerlSockSetsockopt,
1516 PerlSockShutdown,
1517 PerlSockSocket,
1518 PerlSockSocketpair,
1519 PerlSockClosesocket,
1520};
1521
1522
1523/* IPerlProc */
1524
1525#define EXECF_EXEC 1
1526#define EXECF_SPAWN 2
1527
1528void
1529PerlProcAbort(struct IPerlProc* piPerl)
1530{
1531 win32_abort();
1532}
1533
1534char *
1535PerlProcCrypt(struct IPerlProc* piPerl, const char* clear, const char* salt)
1536{
1537 return win32_crypt(clear, salt);
1538}
1539
084b56d7 1540PERL_CALLCONV_NO_RET void
7766f137
GS
1541PerlProcExit(struct IPerlProc* piPerl, int status)
1542{
1543 exit(status);
1544}
1545
084b56d7 1546PERL_CALLCONV_NO_RET void
7766f137
GS
1547PerlProc_Exit(struct IPerlProc* piPerl, int status)
1548{
1549 _exit(status);
1550}
1551
1552int
1553PerlProcExecl(struct IPerlProc* piPerl, const char *cmdname, const char *arg0, const char *arg1, const char *arg2, const char *arg3)
1554{
1555 return execl(cmdname, arg0, arg1, arg2, arg3);
1556}
1557
1558int
1559PerlProcExecv(struct IPerlProc* piPerl, const char *cmdname, const char *const *argv)
1560{
1561 return win32_execvp(cmdname, argv);
1562}
1563
1564int
1565PerlProcExecvp(struct IPerlProc* piPerl, const char *cmdname, const char *const *argv)
1566{
1567 return win32_execvp(cmdname, argv);
1568}
1569
1570uid_t
1571PerlProcGetuid(struct IPerlProc* piPerl)
1572{
1573 return getuid();
1574}
1575
1576uid_t
1577PerlProcGeteuid(struct IPerlProc* piPerl)
1578{
1579 return geteuid();
1580}
1581
1582gid_t
1583PerlProcGetgid(struct IPerlProc* piPerl)
1584{
1585 return getgid();
1586}
1587
1588gid_t
1589PerlProcGetegid(struct IPerlProc* piPerl)
1590{
1591 return getegid();
1592}
1593
1594char *
1595PerlProcGetlogin(struct IPerlProc* piPerl)
1596{
1597 return g_getlogin();
1598}
1599
1600int
1601PerlProcKill(struct IPerlProc* piPerl, int pid, int sig)
1602{
1603 return win32_kill(pid, sig);
1604}
1605
1606int
1607PerlProcKillpg(struct IPerlProc* piPerl, int pid, int sig)
1608{
542cb85f 1609 return win32_kill(pid, -sig);
7766f137
GS
1610}
1611
1612int
1613PerlProcPauseProc(struct IPerlProc* piPerl)
1614{
bbc9927b 1615 return win32_pause();
7766f137
GS
1616}
1617
1618PerlIO*
1619PerlProcPopen(struct IPerlProc* piPerl, const char *command, const char *mode)
1620{
acfe0abc 1621 dTHX;
7766f137 1622 PERL_FLUSHALL_FOR_CHILD;
adb71456 1623 return win32_popen(command, mode);
7766f137
GS
1624}
1625
8c0134a8
NIS
1626PerlIO*
1627PerlProcPopenList(struct IPerlProc* piPerl, const char *mode, IV narg, SV **args)
1628{
acfe0abc 1629 dTHX;
8c0134a8
NIS
1630 PERL_FLUSHALL_FOR_CHILD;
1631 return win32_popenlist(mode, narg, args);
1632}
1633
7766f137
GS
1634int
1635PerlProcPclose(struct IPerlProc* piPerl, PerlIO *stream)
1636{
adb71456 1637 return win32_pclose(stream);
7766f137
GS
1638}
1639
1640int
1641PerlProcPipe(struct IPerlProc* piPerl, int *phandles)
1642{
1643 return win32_pipe(phandles, 512, O_BINARY);
1644}
1645
1646int
1647PerlProcSetuid(struct IPerlProc* piPerl, uid_t u)
1648{
1649 return setuid(u);
1650}
1651
1652int
1653PerlProcSetgid(struct IPerlProc* piPerl, gid_t g)
1654{
1655 return setgid(g);
1656}
1657
1658int
1659PerlProcSleep(struct IPerlProc* piPerl, unsigned int s)
1660{
1661 return win32_sleep(s);
1662}
1663
1664int
1665PerlProcTimes(struct IPerlProc* piPerl, struct tms *timebuf)
1666{
1667 return win32_times(timebuf);
1668}
1669
1670int
1671PerlProcWait(struct IPerlProc* piPerl, int *status)
1672{
1673 return win32_wait(status);
1674}
1675
1676int
1677PerlProcWaitpid(struct IPerlProc* piPerl, int pid, int *status, int flags)
1678{
1679 return win32_waitpid(pid, status, flags);
1680}
1681
1682Sighandler_t
1683PerlProcSignal(struct IPerlProc* piPerl, int sig, Sighandler_t subcode)
1684{
3fadfdf1 1685 return win32_signal(sig, subcode);
7766f137
GS
1686}
1687
57ab3dfe
GS
1688int
1689PerlProcGetTimeOfDay(struct IPerlProc* piPerl, struct timeval *t, void *z)
1690{
1691 return win32_gettimeofday(t, z);
1692}
1693
8454a2ba 1694#ifdef USE_ITHREADS
c00206c8 1695static THREAD_RET_TYPE
7766f137
GS
1696win32_start_child(LPVOID arg)
1697{
1698 PerlInterpreter *my_perl = (PerlInterpreter*)arg;
7766f137 1699 int status;
aeecf691 1700 HWND parent_message_hwnd;
7766f137
GS
1701#ifdef PERL_SYNC_FORK
1702 static long sync_fork_id = 0;
1703 long id = ++sync_fork_id;
1704#endif
1705
1706
ba869deb 1707 PERL_SET_THX(my_perl);
222c300a 1708 win32_checkTLS(my_perl);
7766f137 1709
7766f137
GS
1710#ifdef PERL_SYNC_FORK
1711 w32_pseudo_id = id;
1712#else
1713 w32_pseudo_id = GetCurrentThreadId();
1714#endif
6a04c246 1715#ifdef PERL_USES_PL_PIDSTATUS
7766f137 1716 hv_clear(PL_pidstatus);
6a04c246 1717#endif
7766f137 1718
aeecf691
JD
1719 /* create message window and tell parent about it */
1720 parent_message_hwnd = w32_message_hwnd;
1721 w32_message_hwnd = win32_create_message_window();
1722 if (parent_message_hwnd != NULL)
fa58a56f 1723 PostMessage(parent_message_hwnd, WM_USER_MESSAGE, w32_pseudo_id, (LPARAM)w32_message_hwnd);
aeecf691 1724
7766f137
GS
1725 /* push a zero on the stack (we are the child) */
1726 {
1604cfb0
MS
1727 dSP;
1728 dTARGET;
1729 PUSHi(0);
1730 PUTBACK;
7766f137
GS
1731 }
1732
1733 /* continue from next op */
1734 PL_op = PL_op->op_next;
1735
1736 {
1604cfb0
MS
1737 dJMPENV;
1738 volatile int oldscope = 1; /* We are responsible for all scopes */
7766f137
GS
1739
1740restart:
1604cfb0
MS
1741 JMPENV_PUSH(status);
1742 switch (status) {
1743 case 0:
1744 CALLRUNOPS(aTHX);
adab9969
JD
1745 /* We may have additional unclosed scopes if fork() was called
1746 * from within a BEGIN block. See perlfork.pod for more details.
1cb985b0
JD
1747 * We cannot clean up these other scopes because they belong to a
1748 * different interpreter, but we also cannot leave PL_scopestack_ix
1749 * dangling because that can trigger an assertion in perl_destruct().
adab9969 1750 */
1cb985b0
JD
1751 if (PL_scopestack_ix > oldscope) {
1752 PL_scopestack[oldscope-1] = PL_scopestack[PL_scopestack_ix-1];
1753 PL_scopestack_ix = oldscope;
1754 }
1604cfb0
MS
1755 status = 0;
1756 break;
1757 case 2:
1758 while (PL_scopestack_ix > oldscope)
1759 LEAVE;
1760 FREETMPS;
1761 PL_curstash = PL_defstash;
1762 if (PL_curstash != PL_defstash) {
1763 SvREFCNT_dec(PL_curstash);
1764 PL_curstash = (HV *)SvREFCNT_inc(PL_defstash);
1765 }
1766 if (PL_endav && !PL_minus_c) {
1767 PERL_SET_PHASE(PERL_PHASE_END);
1768 call_list(oldscope, PL_endav);
1769 }
1770 status = STATUS_EXIT;
1771 break;
1772 case 3:
1773 if (PL_restartop) {
1774 POPSTACK_TO(PL_mainstack);
1775 PL_op = PL_restartop;
1776 PL_restartop = (OP*)NULL;
1777 goto restart;
1778 }
1779 PerlIO_printf(Perl_error_log, "panic: restartop\n");
1780 FREETMPS;
1781 status = 1;
1782 break;
1783 }
1784 JMPENV_POP;
1785
1786 /* XXX hack to avoid perl_destruct() freeing optree */
222c300a 1787 win32_checkTLS(my_perl);
1604cfb0 1788 PL_main_root = (OP*)NULL;
7766f137
GS
1789 }
1790
222c300a 1791 win32_checkTLS(my_perl);
1c0ca838
GS
1792 /* close the std handles to avoid fd leaks */
1793 {
1604cfb0
MS
1794 do_close(PL_stdingv, FALSE);
1795 do_close(gv_fetchpv("STDOUT", TRUE, SVt_PVIO), FALSE); /* PL_stdoutgv - ISAGN */
1796 do_close(PL_stderrgv, FALSE);
1c0ca838
GS
1797 }
1798
7766f137 1799 /* destroy everything (waits for any pseudo-forked children) */
222c300a 1800 win32_checkTLS(my_perl);
7766f137 1801 perl_destruct(my_perl);
222c300a 1802 win32_checkTLS(my_perl);
7766f137
GS
1803 perl_free(my_perl);
1804
1805#ifdef PERL_SYNC_FORK
1806 return id;
1807#else
1808 return (DWORD)status;
1809#endif
1810}
8454a2ba 1811#endif /* USE_ITHREADS */
7766f137
GS
1812
1813int
1814PerlProcFork(struct IPerlProc* piPerl)
1815{
8454a2ba 1816#ifdef USE_ITHREADS
9399a70c 1817 dTHX;
7766f137
GS
1818 DWORD id;
1819 HANDLE handle;
7a955601
GS
1820 CPerlHost *h;
1821
1822 if (w32_num_pseudo_children >= MAXIMUM_WAIT_OBJECTS) {
1604cfb0
MS
1823 errno = EAGAIN;
1824 return -1;
7a955601
GS
1825 }
1826 h = new CPerlHost(*(CPerlHost*)w32_internal_host);
46a76da7 1827 PerlInterpreter *new_perl = perl_clone_using((PerlInterpreter*)aTHX,
1604cfb0
MS
1828 CLONEf_COPY_STACKS,
1829 h->m_pHostperlMem,
1830 h->m_pHostperlMemShared,
1831 h->m_pHostperlMemParse,
1832 h->m_pHostperlEnv,
1833 h->m_pHostperlStdIO,
1834 h->m_pHostperlLIO,
1835 h->m_pHostperlDir,
1836 h->m_pHostperlSock,
1837 h->m_pHostperlProc
1838 );
ad4e2db7 1839 new_perl->Isys_intern.internal_host = h;
222c300a 1840 h->host_perl = new_perl;
8454a2ba 1841# ifdef PERL_SYNC_FORK
7766f137 1842 id = win32_start_child((LPVOID)new_perl);
acfe0abc 1843 PERL_SET_THX(aTHX);
8454a2ba 1844# else
aeecf691
JD
1845 if (w32_message_hwnd == INVALID_HANDLE_VALUE)
1846 w32_message_hwnd = win32_create_message_window();
1847 new_perl->Isys_intern.message_hwnd = w32_message_hwnd;
1848 w32_pseudo_child_message_hwnds[w32_num_pseudo_children] =
777c9af2 1849 (w32_message_hwnd == NULL) ? (HWND)NULL : (HWND)INVALID_HANDLE_VALUE;
c00206c8
GS
1850# ifdef USE_RTL_THREAD_API
1851 handle = (HANDLE)_beginthreadex((void*)NULL, 0, win32_start_child,
1604cfb0 1852 (void*)new_perl, 0, (unsigned*)&id);
c00206c8 1853# else
7766f137 1854 handle = CreateThread(NULL, 0, win32_start_child,
1604cfb0 1855 (LPVOID)new_perl, 0, &id);
c00206c8 1856# endif
acfe0abc 1857 PERL_SET_THX(aTHX); /* XXX perl_clone*() set TLS */
60fa28ff 1858 if (!handle) {
1604cfb0
MS
1859 errno = EAGAIN;
1860 return -1;
60fa28ff 1861 }
7766f137
GS
1862 w32_pseudo_child_handles[w32_num_pseudo_children] = handle;
1863 w32_pseudo_child_pids[w32_num_pseudo_children] = id;
8a3cb9c6 1864 w32_pseudo_child_sigterm[w32_num_pseudo_children] = 0;
7766f137 1865 ++w32_num_pseudo_children;
8454a2ba 1866# endif
7766f137 1867 return -(int)id;
8454a2ba 1868#else
073dd035 1869 win32_croak_not_implemented("fork()");
8454a2ba
GS
1870 return -1;
1871#endif /* USE_ITHREADS */
7766f137
GS
1872}
1873
1874int
1875PerlProcGetpid(struct IPerlProc* piPerl)
1876{
1877 return win32_getpid();
1878}
1879
1880void*
1881PerlProcDynaLoader(struct IPerlProc* piPerl, const char* filename)
1882{
1883 return win32_dynaload(filename);
1884}
1885
1886void
1887PerlProcGetOSError(struct IPerlProc* piPerl, SV* sv, DWORD dwErr)
1888{
1889 win32_str_os_error(sv, dwErr);
1890}
1891
7766f137
GS
1892int
1893PerlProcSpawnvp(struct IPerlProc* piPerl, int mode, const char *cmdname, const char *const *argv)
1894{
1895 return win32_spawnvp(mode, cmdname, argv);
1896}
1897
1898int
5f1a76d0
NIS
1899PerlProcLastHost(struct IPerlProc* piPerl)
1900{
dbf7dff6
DD
1901 /* this dTHX is unused in an optimized build since CPerlHost::num_hosts
1902 is a static */
acfe0abc 1903 dTHX;
5f1a76d0
NIS
1904 CPerlHost *h = (CPerlHost*)w32_internal_host;
1905 return h->LastHost();
1906}
1907
af2f850f 1908const struct IPerlProc perlProc =
7766f137
GS
1909{
1910 PerlProcAbort,
1911 PerlProcCrypt,
1912 PerlProcExit,
1913 PerlProc_Exit,
1914 PerlProcExecl,
1915 PerlProcExecv,
1916 PerlProcExecvp,
1917 PerlProcGetuid,
1918 PerlProcGeteuid,
1919 PerlProcGetgid,
1920 PerlProcGetegid,
1921 PerlProcGetlogin,
1922 PerlProcKill,
1923 PerlProcKillpg,
1924 PerlProcPauseProc,
1925 PerlProcPopen,
1926 PerlProcPclose,
1927 PerlProcPipe,
1928 PerlProcSetuid,
1929 PerlProcSetgid,
1930 PerlProcSleep,
1931 PerlProcTimes,
1932 PerlProcWait,
1933 PerlProcWaitpid,
1934 PerlProcSignal,
1935 PerlProcFork,
1936 PerlProcGetpid,
1937 PerlProcDynaLoader,
1938 PerlProcGetOSError,
7766f137 1939 PerlProcSpawnvp,
8c0134a8 1940 PerlProcLastHost,
57ab3dfe
GS
1941 PerlProcPopenList,
1942 PerlProcGetTimeOfDay
7766f137
GS
1943};
1944
1945
1946/*
1947 * CPerlHost
1948 */
1949
1950CPerlHost::CPerlHost(void)
1951{
5f1a76d0
NIS
1952 /* Construct a host from scratch */
1953 InterlockedIncrement(&num_hosts);
7766f137
GS
1954 m_pvDir = new VDir();
1955 m_pVMem = new VMem();
1956 m_pVMemShared = new VMem();
1957 m_pVMemParse = new VMem();
1958
1959 m_pvDir->Init(NULL, m_pVMem);
1960
1961 m_dwEnvCount = 0;
1962 m_lppEnvList = NULL;
85fdc8b6 1963 m_bTopLevel = TRUE;
7766f137
GS
1964
1965 CopyMemory(&m_hostperlMem, &perlMem, sizeof(perlMem));
1966 CopyMemory(&m_hostperlMemShared, &perlMemShared, sizeof(perlMemShared));
1967 CopyMemory(&m_hostperlMemParse, &perlMemParse, sizeof(perlMemParse));
1968 CopyMemory(&m_hostperlEnv, &perlEnv, sizeof(perlEnv));
1969 CopyMemory(&m_hostperlStdIO, &perlStdIO, sizeof(perlStdIO));
1970 CopyMemory(&m_hostperlLIO, &perlLIO, sizeof(perlLIO));
1971 CopyMemory(&m_hostperlDir, &perlDir, sizeof(perlDir));
1972 CopyMemory(&m_hostperlSock, &perlSock, sizeof(perlSock));
1973 CopyMemory(&m_hostperlProc, &perlProc, sizeof(perlProc));
1974
1975 m_pHostperlMem = &m_hostperlMem;
1976 m_pHostperlMemShared = &m_hostperlMemShared;
1977 m_pHostperlMemParse = &m_hostperlMemParse;
1978 m_pHostperlEnv = &m_hostperlEnv;
1979 m_pHostperlStdIO = &m_hostperlStdIO;
1980 m_pHostperlLIO = &m_hostperlLIO;
1981 m_pHostperlDir = &m_hostperlDir;
1982 m_pHostperlSock = &m_hostperlSock;
1983 m_pHostperlProc = &m_hostperlProc;
1984}
1985
1986#define SETUPEXCHANGE(xptr, iptr, table) \
1987 STMT_START { \
1604cfb0
MS
1988 if (xptr) { \
1989 iptr = *xptr; \
1990 *xptr = &table; \
1991 } \
1992 else { \
1993 iptr = &table; \
1994 } \
7766f137
GS
1995 } STMT_END
1996
1997CPerlHost::CPerlHost(struct IPerlMem** ppMem, struct IPerlMem** ppMemShared,
1604cfb0
MS
1998 struct IPerlMem** ppMemParse, struct IPerlEnv** ppEnv,
1999 struct IPerlStdIO** ppStdIO, struct IPerlLIO** ppLIO,
2000 struct IPerlDir** ppDir, struct IPerlSock** ppSock,
2001 struct IPerlProc** ppProc)
7766f137 2002{
5f1a76d0 2003 InterlockedIncrement(&num_hosts);
f7aeb604 2004 m_pvDir = new VDir(0);
7766f137
GS
2005 m_pVMem = new VMem();
2006 m_pVMemShared = new VMem();
2007 m_pVMemParse = new VMem();
2008
2009 m_pvDir->Init(NULL, m_pVMem);
2010
2011 m_dwEnvCount = 0;
2012 m_lppEnvList = NULL;
85fdc8b6 2013 m_bTopLevel = FALSE;
7766f137
GS
2014
2015 CopyMemory(&m_hostperlMem, &perlMem, sizeof(perlMem));
2016 CopyMemory(&m_hostperlMemShared, &perlMemShared, sizeof(perlMemShared));
2017 CopyMemory(&m_hostperlMemParse, &perlMemParse, sizeof(perlMemParse));
2018 CopyMemory(&m_hostperlEnv, &perlEnv, sizeof(perlEnv));
2019 CopyMemory(&m_hostperlStdIO, &perlStdIO, sizeof(perlStdIO));
2020 CopyMemory(&m_hostperlLIO, &perlLIO, sizeof(perlLIO));
2021 CopyMemory(&m_hostperlDir, &perlDir, sizeof(perlDir));
2022 CopyMemory(&m_hostperlSock, &perlSock, sizeof(perlSock));
2023 CopyMemory(&m_hostperlProc, &perlProc, sizeof(perlProc));
2024
2025 SETUPEXCHANGE(ppMem, m_pHostperlMem, m_hostperlMem);
2026 SETUPEXCHANGE(ppMemShared, m_pHostperlMemShared, m_hostperlMemShared);
2027 SETUPEXCHANGE(ppMemParse, m_pHostperlMemParse, m_hostperlMemParse);
2028 SETUPEXCHANGE(ppEnv, m_pHostperlEnv, m_hostperlEnv);
2029 SETUPEXCHANGE(ppStdIO, m_pHostperlStdIO, m_hostperlStdIO);
2030 SETUPEXCHANGE(ppLIO, m_pHostperlLIO, m_hostperlLIO);
2031 SETUPEXCHANGE(ppDir, m_pHostperlDir, m_hostperlDir);
2032 SETUPEXCHANGE(ppSock, m_pHostperlSock, m_hostperlSock);
2033 SETUPEXCHANGE(ppProc, m_pHostperlProc, m_hostperlProc);
2034}
2035#undef SETUPEXCHANGE
2036
2037CPerlHost::CPerlHost(CPerlHost& host)
2038{
5f1a76d0
NIS
2039 /* Construct a host from another host */
2040 InterlockedIncrement(&num_hosts);
7766f137
GS
2041 m_pVMem = new VMem();
2042 m_pVMemShared = host.GetMemShared();
2043 m_pVMemParse = host.GetMemParse();
2044
2045 /* duplicate directory info */
f7aeb604 2046 m_pvDir = new VDir(0);
7766f137
GS
2047 m_pvDir->Init(host.GetDir(), m_pVMem);
2048
2049 CopyMemory(&m_hostperlMem, &perlMem, sizeof(perlMem));
2050 CopyMemory(&m_hostperlMemShared, &perlMemShared, sizeof(perlMemShared));
2051 CopyMemory(&m_hostperlMemParse, &perlMemParse, sizeof(perlMemParse));
2052 CopyMemory(&m_hostperlEnv, &perlEnv, sizeof(perlEnv));
2053 CopyMemory(&m_hostperlStdIO, &perlStdIO, sizeof(perlStdIO));
2054 CopyMemory(&m_hostperlLIO, &perlLIO, sizeof(perlLIO));
2055 CopyMemory(&m_hostperlDir, &perlDir, sizeof(perlDir));
2056 CopyMemory(&m_hostperlSock, &perlSock, sizeof(perlSock));
2057 CopyMemory(&m_hostperlProc, &perlProc, sizeof(perlProc));
ad4e2db7
GS
2058 m_pHostperlMem = &m_hostperlMem;
2059 m_pHostperlMemShared = &m_hostperlMemShared;
2060 m_pHostperlMemParse = &m_hostperlMemParse;
2061 m_pHostperlEnv = &m_hostperlEnv;
2062 m_pHostperlStdIO = &m_hostperlStdIO;
2063 m_pHostperlLIO = &m_hostperlLIO;
2064 m_pHostperlDir = &m_hostperlDir;
2065 m_pHostperlSock = &m_hostperlSock;
2066 m_pHostperlProc = &m_hostperlProc;
7766f137
GS
2067
2068 m_dwEnvCount = 0;
2069 m_lppEnvList = NULL;
85fdc8b6 2070 m_bTopLevel = FALSE;
7766f137
GS
2071
2072 /* duplicate environment info */
2073 LPSTR lpPtr;
2074 DWORD dwIndex = 0;
2075 while(lpPtr = host.GetIndex(dwIndex))
1604cfb0 2076 Add(lpPtr);
7766f137
GS
2077}
2078
2079CPerlHost::~CPerlHost(void)
2080{
2b93cd4d 2081 Reset();
5f1a76d0 2082 InterlockedDecrement(&num_hosts);
7766f137
GS
2083 delete m_pvDir;
2084 m_pVMemParse->Release();
2085 m_pVMemShared->Release();
2086 m_pVMem->Release();
2087}
2088
2089LPSTR
2090CPerlHost::Find(LPCSTR lpStr)
2091{
2092 LPSTR lpPtr;
2093 LPSTR* lppPtr = Lookup(lpStr);
2094 if(lppPtr != NULL) {
1604cfb0
MS
2095 for(lpPtr = *lppPtr; *lpPtr != '\0' && *lpPtr != '='; ++lpPtr)
2096 ;
7766f137 2097
1604cfb0
MS
2098 if(*lpPtr == '=')
2099 ++lpPtr;
7766f137 2100
1604cfb0 2101 return lpPtr;
7766f137
GS
2102 }
2103 return NULL;
2104}
2105
2106int
2107lookup(const void *arg1, const void *arg2)
52cbf511 2108{ // Compare strings
7766f137
GS
2109 char*ptr1, *ptr2;
2110 char c1,c2;
2111
2112 ptr1 = *(char**)arg1;
2113 ptr2 = *(char**)arg2;
2114 for(;;) {
1604cfb0
MS
2115 c1 = *ptr1++;
2116 c2 = *ptr2++;
2117 if(c1 == '\0' || c1 == '=') {
2118 if(c2 == '\0' || c2 == '=')
2119 break;
2120
2121 return -1; // string 1 < string 2
2122 }
2123 else if(c2 == '\0' || c2 == '=')
2124 return 1; // string 1 > string 2
2125 else if(c1 != c2) {
2126 c1 = toupper(c1);
2127 c2 = toupper(c2);
2128 if(c1 != c2) {
2129 if(c1 < c2)
2130 return -1; // string 1 < string 2
2131
2132 return 1; // string 1 > string 2
2133 }
2134 }
7766f137
GS
2135 }
2136 return 0;
2137}
2138
2139LPSTR*
2140CPerlHost::Lookup(LPCSTR lpStr)
2141{
2b93cd4d 2142 if (!lpStr)
1604cfb0 2143 return NULL;
7766f137
GS
2144 return (LPSTR*)bsearch(&lpStr, m_lppEnvList, m_dwEnvCount, sizeof(LPSTR), lookup);
2145}
2146
2147int
2148compare(const void *arg1, const void *arg2)
52cbf511 2149{ // Compare strings
7766f137
GS
2150 char*ptr1, *ptr2;
2151 char c1,c2;
2152
2153 ptr1 = *(char**)arg1;
2154 ptr2 = *(char**)arg2;
2155 for(;;) {
1604cfb0
MS
2156 c1 = *ptr1++;
2157 c2 = *ptr2++;
2158 if(c1 == '\0' || c1 == '=') {
2159 if(c1 == c2)
2160 break;
2161
2162 return -1; // string 1 < string 2
2163 }
2164 else if(c2 == '\0' || c2 == '=')
2165 return 1; // string 1 > string 2
2166 else if(c1 != c2) {
2167 c1 = toupper(c1);
2168 c2 = toupper(c2);
2169 if(c1 != c2) {
2170 if(c1 < c2)
2171 return -1; // string 1 < string 2
2172
2173 return 1; // string 1 > string 2
2174 }
2175 }
7766f137
GS
2176 }
2177 return 0;
2178}
2179
2180void
2181CPerlHost::Add(LPCSTR lpStr)
2182{
7766f137 2183 LPSTR *lpPtr;
8586647e 2184 STRLEN length = strlen(lpStr)+1;
7766f137 2185
52cbf511 2186 // replacing ?
8586647e 2187 lpPtr = Lookup(lpStr);
2b93cd4d 2188 if (lpPtr != NULL) {
1604cfb0
MS
2189 // must allocate things via host memory allocation functions
2190 // rather than perl's Renew() et al, as the perl interpreter
2191 // may either not be initialized enough when we allocate these,
2192 // or may already be dead when we go to free these
2193 *lpPtr = (char*)Realloc(*lpPtr, length * sizeof(char));
2194 strcpy(*lpPtr, lpStr);
7766f137
GS
2195 }
2196 else {
1604cfb0
MS
2197 m_lppEnvList = (LPSTR*)Realloc(m_lppEnvList, (m_dwEnvCount+1) * sizeof(LPSTR));
2198 if (m_lppEnvList) {
2199 m_lppEnvList[m_dwEnvCount] = (char*)Malloc(length * sizeof(char));
2200 if (m_lppEnvList[m_dwEnvCount] != NULL) {
2201 strcpy(m_lppEnvList[m_dwEnvCount], lpStr);
2202 ++m_dwEnvCount;
2203 qsort(m_lppEnvList, m_dwEnvCount, sizeof(LPSTR), compare);
2204 }
2205 }
7766f137
GS
2206 }
2207}
2208
2209DWORD
2210CPerlHost::CalculateEnvironmentSpace(void)
2211{
2212 DWORD index;
2213 DWORD dwSize = 0;
2214 for(index = 0; index < m_dwEnvCount; ++index)
1604cfb0 2215 dwSize += strlen(m_lppEnvList[index]) + 1;
7766f137
GS
2216
2217 return dwSize;
2218}
2219
2220void
2221CPerlHost::FreeLocalEnvironmentStrings(LPSTR lpStr)
2222{
7766f137
GS
2223 Safefree(lpStr);
2224}
2225
2226char*
2227CPerlHost::GetChildDir(void)
2228{
7766f137 2229 char* ptr;
d684b162
JD
2230 size_t length;
2231
aa2b96ec
JD
2232 Newx(ptr, MAX_PATH+1, char);
2233 m_pvDir->GetCurrentDirectoryA(MAX_PATH+1, ptr);
d684b162
JD
2234 length = strlen(ptr);
2235 if (length > 3) {
2236 if ((ptr[length-1] == '\\') || (ptr[length-1] == '/'))
2237 ptr[length-1] = 0;
7766f137
GS
2238 }
2239 return ptr;
2240}
2241
2242void
2243CPerlHost::FreeChildDir(char* pStr)
2244{
7766f137
GS
2245 Safefree(pStr);
2246}
2247
2248LPSTR
2249CPerlHost::CreateLocalEnvironmentStrings(VDir &vDir)
2250{
7766f137
GS
2251 LPSTR lpStr, lpPtr, lpEnvPtr, lpTmp, lpLocalEnv, lpAllocPtr;
2252 DWORD dwSize, dwEnvIndex;
2253 int nLength, compVal;
2254
52cbf511 2255 // get the process environment strings
4f46e52b 2256 lpAllocPtr = lpTmp = (LPSTR)win32_getenvironmentstrings();
7766f137 2257
52cbf511 2258 // step over current directory stuff
7766f137 2259 while(*lpTmp == '=')
1604cfb0 2260 lpTmp += strlen(lpTmp) + 1;
7766f137 2261
52cbf511 2262 // save the start of the environment strings
7766f137
GS
2263 lpEnvPtr = lpTmp;
2264 for(dwSize = 1; *lpTmp != '\0'; lpTmp += strlen(lpTmp) + 1) {
1604cfb0
MS
2265 // calculate the size of the environment strings
2266 dwSize += strlen(lpTmp) + 1;
7766f137
GS
2267 }
2268
52cbf511 2269 // add the size of current directories
7766f137
GS
2270 dwSize += vDir.CalculateEnvironmentSpace();
2271
52cbf511 2272 // add the additional space used by changes made to the environment
7766f137
GS
2273 dwSize += CalculateEnvironmentSpace();
2274
a02a5408 2275 Newx(lpStr, dwSize, char);
7766f137
GS
2276 lpPtr = lpStr;
2277 if(lpStr != NULL) {
1604cfb0
MS
2278 // build the local environment
2279 lpStr = vDir.BuildEnvironmentSpace(lpStr);
2280
2281 dwEnvIndex = 0;
2282 lpLocalEnv = GetIndex(dwEnvIndex);
2283 while(*lpEnvPtr != '\0') {
2284 if(!lpLocalEnv) {
2285 // all environment overrides have been added
2286 // so copy string into place
2287 strcpy(lpStr, lpEnvPtr);
2288 nLength = strlen(lpEnvPtr) + 1;
2289 lpStr += nLength;
2290 lpEnvPtr += nLength;
2291 }
2292 else {
2293 // determine which string to copy next
2294 compVal = compare(&lpEnvPtr, &lpLocalEnv);
2295 if(compVal < 0) {
2296 strcpy(lpStr, lpEnvPtr);
2297 nLength = strlen(lpEnvPtr) + 1;
2298 lpStr += nLength;
2299 lpEnvPtr += nLength;
2300 }
2301 else {
2302 char *ptr = strchr(lpLocalEnv, '=');
2303 if(ptr && ptr[1]) {
2304 strcpy(lpStr, lpLocalEnv);
2305 lpStr += strlen(lpLocalEnv) + 1;
2306 }
2307 lpLocalEnv = GetIndex(dwEnvIndex);
2308 if(compVal == 0) {
2309 // this string was replaced
2310 lpEnvPtr += strlen(lpEnvPtr) + 1;
2311 }
2312 }
2313 }
2314 }
2315
2316 while(lpLocalEnv) {
2317 // still have environment overrides to add
2318 // so copy the strings into place if not an override
2319 char *ptr = strchr(lpLocalEnv, '=');
2320 if(ptr && ptr[1]) {
2321 strcpy(lpStr, lpLocalEnv);
2322 lpStr += strlen(lpLocalEnv) + 1;
2323 }
2324 lpLocalEnv = GetIndex(dwEnvIndex);
2325 }
2326
2327 // add final NULL
2328 *lpStr = '\0';
7766f137
GS
2329 }
2330
52cbf511 2331 // release the process environment strings
4f46e52b 2332 win32_freeenvironmentstrings(lpAllocPtr);
7766f137
GS
2333
2334 return lpPtr;
2335}
2336
2337void
2338CPerlHost::Reset(void)
2339{
7766f137 2340 if(m_lppEnvList != NULL) {
1604cfb0
MS
2341 for(DWORD index = 0; index < m_dwEnvCount; ++index) {
2342 Free(m_lppEnvList[index]);
2343 m_lppEnvList[index] = NULL;
2344 }
7766f137
GS
2345 }
2346 m_dwEnvCount = 0;
2b93cd4d
GS
2347 Free(m_lppEnvList);
2348 m_lppEnvList = NULL;
7766f137
GS
2349}
2350
2351void
2352CPerlHost::Clearenv(void)
2353{
2354 char ch;
2355 LPSTR lpPtr, lpStr, lpEnvPtr;
2fb9ab56 2356 if (m_lppEnvList != NULL) {
1604cfb0
MS
2357 /* set every entry to an empty string */
2358 for(DWORD index = 0; index < m_dwEnvCount; ++index) {
2359 char* ptr = strchr(m_lppEnvList[index], '=');
2360 if(ptr) {
2361 *++ptr = 0;
2362 }
2363 }
7766f137
GS
2364 }
2365
2366 /* get the process environment strings */
4f46e52b 2367 lpStr = lpEnvPtr = (LPSTR)win32_getenvironmentstrings();
7766f137
GS
2368
2369 /* step over current directory stuff */
2370 while(*lpStr == '=')
1604cfb0 2371 lpStr += strlen(lpStr) + 1;
7766f137
GS
2372
2373 while(*lpStr) {
1604cfb0
MS
2374 lpPtr = strchr(lpStr, '=');
2375 if(lpPtr) {
2376 ch = *++lpPtr;
2377 *lpPtr = 0;
2378 Add(lpStr);
2379 if (m_bTopLevel)
2380 (void)win32_putenv(lpStr);
2381 *lpPtr = ch;
2382 }
2383 lpStr += strlen(lpStr) + 1;
7766f137
GS
2384 }
2385
4f46e52b 2386 win32_freeenvironmentstrings(lpEnvPtr);
7766f137
GS
2387}
2388
2389
2390char*
2391CPerlHost::Getenv(const char *varname)
2392{
85fdc8b6 2393 if (!m_bTopLevel) {
1604cfb0
MS
2394 char *pEnv = Find(varname);
2395 if (pEnv && *pEnv)
2396 return pEnv;
7766f137 2397 }
2fb9ab56 2398 return win32_getenv(varname);
7766f137
GS
2399}
2400
2401int
2402CPerlHost::Putenv(const char *envstring)
2403{
2404 Add(envstring);
85fdc8b6 2405 if (m_bTopLevel)
1604cfb0 2406 return win32_putenv(envstring);
2fb9ab56 2407
7766f137
GS
2408 return 0;
2409}
2410
2411int
2412CPerlHost::Chdir(const char *dirname)
2413{
7766f137 2414 int ret;
9ec3348a 2415 if (!dirname) {
1604cfb0
MS
2416 errno = ENOENT;
2417 return -1;
9ec3348a 2418 }
8c56068e 2419 ret = m_pvDir->SetCurrentDirectoryA((char*)dirname);
7766f137 2420 if(ret < 0) {
1604cfb0 2421 errno = ENOENT;
7766f137
GS
2422 }
2423 return ret;
2424}
2425
2426#endif /* ___PerlHost_H___ */