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