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