Support one-parameter unpack(), which unpacks $_.
[perl.git] / reentr.c
1 /*
2  *    reentr.c
3  *
4  *    Copyright (c) 1997-2002, Larry Wall
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  *  !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!!
10  *  This file is built by reentrl.pl from data in reentr.pl.
11  *
12  * "Saruman," I said, standing away from him, "only one hand at a time can
13  *  wield the One, and you know that well, so do not trouble to say we!"
14  *
15  */
16
17 #include "EXTERN.h"
18 #define PERL_IN_REENTR_C
19 #include "perl.h"
20 #include "reentr.h"
21
22 void
23 Perl_reentrant_size(pTHX) {
24 #ifdef USE_REENTRANT_API
25 #define REENTRANTSMALLSIZE       256    /* Make something up. */
26 #define REENTRANTUSUALSIZE      4096    /* Make something up. */
27 #ifdef HAS_ASCTIME_R
28         PL_reentrant_buffer->_asctime_size = REENTRANTSMALLSIZE;
29 #endif /* HAS_ASCTIME_R */
30 #ifdef HAS_CRYPT_R
31 #endif /* HAS_CRYPT_R */
32 #ifdef HAS_CTIME_R
33         PL_reentrant_buffer->_ctime_size = REENTRANTSMALLSIZE;
34 #endif /* HAS_CTIME_R */
35 #ifdef HAS_DRAND48_R
36 #endif /* HAS_DRAND48_R */
37 #ifdef HAS_GETGRNAM_R
38 #   if defined(HAS_SYSCONF) && defined(_SC_GETGR_R_SIZE_MAX) && !defined(__GLIBC__)
39         PL_reentrant_buffer->_grent_size = sysconf(_SC_GETGR_R_SIZE_MAX);
40         if (PL_reentrant_buffer->_grent_size == -1)
41                 PL_reentrant_buffer->_grent_size = REENTRANTUSUALSIZE;
42 #   else
43 #       if defined(__osf__) && defined(__alpha) && defined(SIABUFSIZ)
44         PL_reentrant_buffer->_grent_size = SIABUFSIZ;
45 #       else
46 #           ifdef __sgi
47         PL_reentrant_buffer->_grent_size = BUFSIZ;
48 #           else
49         PL_reentrant_buffer->_grent_size = REENTRANTUSUALSIZE;
50 #           endif
51 #       endif
52 #   endif 
53 #endif /* HAS_GETGRNAM_R */
54 #ifdef HAS_GETHOSTBYNAME_R
55 #if   !(GETHOSTBYNAME_R_PROTO == REENTRANT_PROTO_I_CSD)
56         PL_reentrant_buffer->_hostent_size = REENTRANTUSUALSIZE;
57 #endif
58 #endif /* HAS_GETHOSTBYNAME_R */
59 #ifdef HAS_GETLOGIN_R
60         PL_reentrant_buffer->_getlogin_size = REENTRANTSMALLSIZE;
61 #endif /* HAS_GETLOGIN_R */
62 #ifdef HAS_GETNETBYNAME_R
63 #if   !(GETNETBYNAME_R_PROTO == REENTRANT_PROTO_I_CSD)
64         PL_reentrant_buffer->_netent_size = REENTRANTUSUALSIZE;
65 #endif
66 #endif /* HAS_GETNETBYNAME_R */
67 #ifdef HAS_GETPROTOBYNAME_R
68 #if   !(GETPROTOBYNAME_R_PROTO == REENTRANT_PROTO_I_CSD)
69         PL_reentrant_buffer->_protoent_size = REENTRANTUSUALSIZE;
70 #endif
71 #endif /* HAS_GETPROTOBYNAME_R */
72 #ifdef HAS_GETPWNAM_R
73 #   if defined(HAS_SYSCONF) && defined(_SC_GETPW_R_SIZE_MAX) && !defined(__GLIBC__)
74         PL_reentrant_buffer->_pwent_size = sysconf(_SC_GETPW_R_SIZE_MAX);
75         if (PL_reentrant_buffer->_pwent_size == -1)
76                 PL_reentrant_buffer->_pwent_size = REENTRANTUSUALSIZE;
77 #   else
78 #       if defined(__osf__) && defined(__alpha) && defined(SIABUFSIZ)
79         PL_reentrant_buffer->_pwent_size = SIABUFSIZ;
80 #       else
81 #           ifdef __sgi
82         PL_reentrant_buffer->_pwent_size = BUFSIZ;
83 #           else
84         PL_reentrant_buffer->_pwent_size = REENTRANTUSUALSIZE;
85 #           endif
86 #       endif
87 #   endif 
88 #endif /* HAS_GETPWNAM_R */
89 #ifdef HAS_GETSERVBYNAME_R
90 #if   !(GETSERVBYNAME_R_PROTO == REENTRANT_PROTO_I_CCSD)
91         PL_reentrant_buffer->_servent_size = REENTRANTUSUALSIZE;
92 #endif
93 #endif /* HAS_GETSERVBYNAME_R */
94 #ifdef HAS_GETSPNAM_R
95 #   if defined(HAS_SYSCONF) && defined(_SC_GETPW_R_SIZE_MAX) && !defined(__GLIBC__)
96         PL_reentrant_buffer->_spent_size = sysconf(_SC_GETPW_R_SIZE_MAX);
97         if (PL_reentrant_buffer->_spent_size == -1)
98                 PL_reentrant_buffer->_spent_size = REENTRANTUSUALSIZE;
99 #   else
100 #       if defined(__osf__) && defined(__alpha) && defined(SIABUFSIZ)
101         PL_reentrant_buffer->_spent_size = SIABUFSIZ;
102 #       else
103 #           ifdef __sgi
104         PL_reentrant_buffer->_spent_size = BUFSIZ;
105 #           else
106         PL_reentrant_buffer->_spent_size = REENTRANTUSUALSIZE;
107 #           endif
108 #       endif
109 #   endif 
110 #endif /* HAS_GETSPNAM_R */
111 #ifdef HAS_GMTIME_R
112 #endif /* HAS_GMTIME_R */
113 #ifdef HAS_LOCALTIME_R
114 #endif /* HAS_LOCALTIME_R */
115 #ifdef HAS_RANDOM_R
116 #endif /* HAS_RANDOM_R */
117 #ifdef HAS_READDIR_R
118         /* This is the size Solaris recommends.
119          * (though we go static, should use pathconf() instead) */
120         PL_reentrant_buffer->_readdir_size = sizeof(struct dirent) + MAXPATHLEN + 1;
121 #endif /* HAS_READDIR_R */
122 #ifdef HAS_READDIR64_R
123         /* This is the size Solaris recommends.
124          * (though we go static, should use pathconf() instead) */
125         PL_reentrant_buffer->_readdir64_size = sizeof(struct dirent64) + MAXPATHLEN + 1;
126 #endif /* HAS_READDIR64_R */
127 #ifdef HAS_SETLOCALE_R
128         PL_reentrant_buffer->_setlocale_size = REENTRANTSMALLSIZE;
129 #endif /* HAS_SETLOCALE_R */
130 #ifdef HAS_STRERROR_R
131         PL_reentrant_buffer->_strerror_size = REENTRANTSMALLSIZE;
132 #endif /* HAS_STRERROR_R */
133 #ifdef HAS_TTYNAME_R
134         PL_reentrant_buffer->_ttyname_size = REENTRANTSMALLSIZE;
135 #endif /* HAS_TTYNAME_R */
136
137 #endif /* USE_REENTRANT_API */
138 }
139
140 void
141 Perl_reentrant_init(pTHX) {
142 #ifdef USE_REENTRANT_API
143         New(31337, PL_reentrant_buffer, 1, REENTR);
144         Perl_reentrant_size(aTHX);
145 #ifdef HAS_ASCTIME_R
146         New(31338, PL_reentrant_buffer->_asctime_buffer, PL_reentrant_buffer->_asctime_size, char);
147 #endif /* HAS_ASCTIME_R */
148 #ifdef HAS_CRYPT_R
149 #ifdef __GLIBC__
150         PL_reentrant_buffer->_crypt_struct.initialized = 0;
151         /* work around glibc-2.2.5 bug */
152         PL_reentrant_buffer->_crypt_struct.current_saltbits = 0;
153 #endif
154 #endif /* HAS_CRYPT_R */
155 #ifdef HAS_CTIME_R
156         New(31338, PL_reentrant_buffer->_ctime_buffer, PL_reentrant_buffer->_ctime_size, char);
157 #endif /* HAS_CTIME_R */
158 #ifdef HAS_DRAND48_R
159 #endif /* HAS_DRAND48_R */
160 #ifdef HAS_GETGRNAM_R
161 #   ifdef USE_GRENT_FPTR
162         PL_reentrant_buffer->_grent_fptr = NULL;
163 #   endif
164         New(31338, PL_reentrant_buffer->_grent_buffer, PL_reentrant_buffer->_grent_size, char);
165 #endif /* HAS_GETGRNAM_R */
166 #ifdef HAS_GETHOSTBYNAME_R
167 #if   !(GETHOSTBYNAME_R_PROTO == REENTRANT_PROTO_I_CSD)
168         New(31338, PL_reentrant_buffer->_hostent_buffer, PL_reentrant_buffer->_hostent_size, char);
169 #endif
170 #endif /* HAS_GETHOSTBYNAME_R */
171 #ifdef HAS_GETLOGIN_R
172         New(31338, PL_reentrant_buffer->_getlogin_buffer, PL_reentrant_buffer->_getlogin_size, char);
173 #endif /* HAS_GETLOGIN_R */
174 #ifdef HAS_GETNETBYNAME_R
175 #if   !(GETNETBYNAME_R_PROTO == REENTRANT_PROTO_I_CSD)
176         New(31338, PL_reentrant_buffer->_netent_buffer, PL_reentrant_buffer->_netent_size, char);
177 #endif
178 #endif /* HAS_GETNETBYNAME_R */
179 #ifdef HAS_GETPROTOBYNAME_R
180 #if   !(GETPROTOBYNAME_R_PROTO == REENTRANT_PROTO_I_CSD)
181         New(31338, PL_reentrant_buffer->_protoent_buffer, PL_reentrant_buffer->_protoent_size, char);
182 #endif
183 #endif /* HAS_GETPROTOBYNAME_R */
184 #ifdef HAS_GETPWNAM_R
185 #   ifdef USE_PWENT_FPTR
186         PL_reentrant_buffer->_pwent_fptr = NULL;
187 #   endif
188         New(31338, PL_reentrant_buffer->_pwent_buffer, PL_reentrant_buffer->_pwent_size, char);
189 #endif /* HAS_GETPWNAM_R */
190 #ifdef HAS_GETSERVBYNAME_R
191 #if   !(GETSERVBYNAME_R_PROTO == REENTRANT_PROTO_I_CCSD)
192         New(31338, PL_reentrant_buffer->_servent_buffer, PL_reentrant_buffer->_servent_size, char);
193 #endif
194 #endif /* HAS_GETSERVBYNAME_R */
195 #ifdef HAS_GETSPNAM_R
196 #   ifdef USE_SPENT_FPTR
197         PL_reentrant_buffer->_spent_fptr = NULL;
198 #   endif
199         New(31338, PL_reentrant_buffer->_spent_buffer, PL_reentrant_buffer->_spent_size, char);
200 #endif /* HAS_GETSPNAM_R */
201 #ifdef HAS_GMTIME_R
202 #endif /* HAS_GMTIME_R */
203 #ifdef HAS_LOCALTIME_R
204 #endif /* HAS_LOCALTIME_R */
205 #ifdef HAS_RANDOM_R
206 #endif /* HAS_RANDOM_R */
207 #ifdef HAS_READDIR_R
208         PL_reentrant_buffer->_readdir_struct = (struct dirent*)safemalloc(PL_reentrant_buffer->_readdir_size);
209 #endif /* HAS_READDIR_R */
210 #ifdef HAS_READDIR64_R
211         PL_reentrant_buffer->_readdir64_struct = (struct dirent64*)safemalloc(PL_reentrant_buffer->_readdir64_size);
212 #endif /* HAS_READDIR64_R */
213 #ifdef HAS_SETLOCALE_R
214         New(31338, PL_reentrant_buffer->_setlocale_buffer, PL_reentrant_buffer->_setlocale_size, char);
215 #endif /* HAS_SETLOCALE_R */
216 #ifdef HAS_STRERROR_R
217         New(31338, PL_reentrant_buffer->_strerror_buffer, PL_reentrant_buffer->_strerror_size, char);
218 #endif /* HAS_STRERROR_R */
219 #ifdef HAS_TTYNAME_R
220         New(31338, PL_reentrant_buffer->_ttyname_buffer, PL_reentrant_buffer->_ttyname_size, char);
221 #endif /* HAS_TTYNAME_R */
222
223 #endif /* USE_REENTRANT_API */
224 }
225
226 void
227 Perl_reentrant_free(pTHX) {
228 #ifdef USE_REENTRANT_API
229 #ifdef HAS_ASCTIME_R
230         Safefree(PL_reentrant_buffer->_asctime_buffer);
231 #endif /* HAS_ASCTIME_R */
232 #ifdef HAS_CRYPT_R
233 #endif /* HAS_CRYPT_R */
234 #ifdef HAS_CTIME_R
235         Safefree(PL_reentrant_buffer->_ctime_buffer);
236 #endif /* HAS_CTIME_R */
237 #ifdef HAS_DRAND48_R
238 #endif /* HAS_DRAND48_R */
239 #ifdef HAS_GETGRNAM_R
240         Safefree(PL_reentrant_buffer->_grent_buffer);
241 #endif /* HAS_GETGRNAM_R */
242 #ifdef HAS_GETHOSTBYNAME_R
243 #if   !(GETHOSTBYNAME_R_PROTO == REENTRANT_PROTO_I_CSD)
244         Safefree(PL_reentrant_buffer->_hostent_buffer);
245 #endif
246 #endif /* HAS_GETHOSTBYNAME_R */
247 #ifdef HAS_GETLOGIN_R
248         Safefree(PL_reentrant_buffer->_getlogin_buffer);
249 #endif /* HAS_GETLOGIN_R */
250 #ifdef HAS_GETNETBYNAME_R
251 #if   !(GETNETBYNAME_R_PROTO == REENTRANT_PROTO_I_CSD)
252         Safefree(PL_reentrant_buffer->_netent_buffer);
253 #endif
254 #endif /* HAS_GETNETBYNAME_R */
255 #ifdef HAS_GETPROTOBYNAME_R
256 #if   !(GETPROTOBYNAME_R_PROTO == REENTRANT_PROTO_I_CSD)
257         Safefree(PL_reentrant_buffer->_protoent_buffer);
258 #endif
259 #endif /* HAS_GETPROTOBYNAME_R */
260 #ifdef HAS_GETPWNAM_R
261         Safefree(PL_reentrant_buffer->_pwent_buffer);
262 #endif /* HAS_GETPWNAM_R */
263 #ifdef HAS_GETSERVBYNAME_R
264 #if   !(GETSERVBYNAME_R_PROTO == REENTRANT_PROTO_I_CCSD)
265         Safefree(PL_reentrant_buffer->_servent_buffer);
266 #endif
267 #endif /* HAS_GETSERVBYNAME_R */
268 #ifdef HAS_GETSPNAM_R
269         Safefree(PL_reentrant_buffer->_spent_buffer);
270 #endif /* HAS_GETSPNAM_R */
271 #ifdef HAS_GMTIME_R
272 #endif /* HAS_GMTIME_R */
273 #ifdef HAS_LOCALTIME_R
274 #endif /* HAS_LOCALTIME_R */
275 #ifdef HAS_RANDOM_R
276 #endif /* HAS_RANDOM_R */
277 #ifdef HAS_READDIR_R
278         Safefree(PL_reentrant_buffer->_readdir_struct);
279 #endif /* HAS_READDIR_R */
280 #ifdef HAS_READDIR64_R
281         Safefree(PL_reentrant_buffer->_readdir64_struct);
282 #endif /* HAS_READDIR64_R */
283 #ifdef HAS_SETLOCALE_R
284         Safefree(PL_reentrant_buffer->_setlocale_buffer);
285 #endif /* HAS_SETLOCALE_R */
286 #ifdef HAS_STRERROR_R
287         Safefree(PL_reentrant_buffer->_strerror_buffer);
288 #endif /* HAS_STRERROR_R */
289 #ifdef HAS_TTYNAME_R
290         Safefree(PL_reentrant_buffer->_ttyname_buffer);
291 #endif /* HAS_TTYNAME_R */
292
293         Safefree(PL_reentrant_buffer);
294 #endif /* USE_REENTRANT_API */
295 }
296
297 void*
298 Perl_reentrant_retry(const char *f, ...)
299 {
300     dTHX;
301     void *retptr = NULL;
302 #ifdef USE_REENTRANT_API
303 #  if defined(USE_HOSTENT_BUFFER) || defined(USE_GRENT_BUFFER) || defined(USE_NETENT_BUFFER) || defined(USE_PWENT_BUFFER) || defined(USE_PROTOENT_BUFFER) || defined(USE_SRVENT_BUFFER)
304     void *p0;
305 #  endif
306 #  if defined(USE_SERVENT_BUFFER)
307     void *p1;
308 #  endif
309 #  if defined(USE_HOSTENT_BUFFER)
310     size_t asize;
311 #  endif
312 #  if defined(USE_HOSTENT_BUFFER) || defined(USE_NETENT_BUFFER) || defined(USE_PROTOENT_BUFFER) || defined(USE_SERVENT_BUFFER)
313     int anint;
314 #  endif
315     va_list ap;
316
317     va_start(ap, f);
318
319     switch (PL_op->op_type) {
320 #ifdef USE_HOSTENT_BUFFER
321     case OP_GHBYADDR:
322     case OP_GHBYNAME:
323     case OP_GHOSTENT:
324         {
325 #ifdef PERL_REENTRANT_MAXSIZE
326             if (PL_reentrant_buffer->_hostent_size <=
327                 PERL_REENTRANT_MAXSIZE / 2)
328 #endif
329             {
330                 PL_reentrant_buffer->_hostent_size *= 2;
331                 Renew(PL_reentrant_buffer->_hostent_buffer,
332                       PL_reentrant_buffer->_hostent_size, char);
333                 switch (PL_op->op_type) {
334                 case OP_GHBYADDR:
335                     p0    = va_arg(ap, void *);
336                     asize = va_arg(ap, size_t);
337                     anint  = va_arg(ap, int);
338                     retptr = gethostbyaddr(p0, asize, anint); break;
339                 case OP_GHBYNAME:
340                     p0 = va_arg(ap, void *);
341                     retptr = gethostbyname(p0); break;
342                 case OP_GHOSTENT:
343                     retptr = gethostent(); break;
344                 default:
345                     SETERRNO(ERANGE, LIB_INVARG);
346                     break;
347                 }
348             }
349         }
350         break;
351 #endif
352 #ifdef USE_GRENT_BUFFER
353     case OP_GGRNAM:
354     case OP_GGRGID:
355     case OP_GGRENT:
356         {
357 #ifdef PERL_REENTRANT_MAXSIZE
358             if (PL_reentrant_buffer->_grent_size <=
359                 PERL_REENTRANT_MAXSIZE / 2)
360 #endif
361             {
362                 Gid_t gid;
363                 PL_reentrant_buffer->_grent_size *= 2;
364                 Renew(PL_reentrant_buffer->_grent_buffer,
365                       PL_reentrant_buffer->_grent_size, char);
366                 switch (PL_op->op_type) {
367                 case OP_GGRNAM:
368                     p0 = va_arg(ap, void *);
369                     retptr = getgrnam(p0); break;
370                 case OP_GGRGID:
371                     gid = va_arg(ap, Gid_t);
372                     retptr = getgrgid(gid); break;
373                 case OP_GGRENT:
374                     retptr = getgrent(); break;
375                 default:
376                     SETERRNO(ERANGE, LIB_INVARG);
377                     break;
378                 }
379             }
380         }
381         break;
382 #endif
383 #ifdef USE_NETENT_BUFFER
384     case OP_GNBYADDR:
385     case OP_GNBYNAME:
386     case OP_GNETENT:
387         {
388 #ifdef PERL_REENTRANT_MAXSIZE
389             if (PL_reentrant_buffer->_netent_size <=
390                 PERL_REENTRANT_MAXSIZE / 2)
391 #endif
392             {
393                 Netdb_net_t net;
394                 PL_reentrant_buffer->_netent_size *= 2;
395                 Renew(PL_reentrant_buffer->_netent_buffer,
396                       PL_reentrant_buffer->_netent_size, char);
397                 switch (PL_op->op_type) {
398                 case OP_GNBYADDR:
399                     net = va_arg(ap, Netdb_net_t);
400                     anint = va_arg(ap, int);
401                     retptr = getnetbyaddr(net, anint); break;
402                 case OP_GNBYNAME:
403                     p0 = va_arg(ap, void *);
404                     retptr = getnetbyname(p0); break;
405                 case OP_GNETENT:
406                     retptr = getnetent(); break;
407                 default:
408                     SETERRNO(ERANGE, LIB_INVARG);
409                     break;
410                 }
411             }
412         }
413         break;
414 #endif
415 #ifdef USE_PWENT_BUFFER
416     case OP_GPWNAM:
417     case OP_GPWUID:
418     case OP_GPWENT:
419         {
420 #ifdef PERL_REENTRANT_MAXSIZE
421             if (PL_reentrant_buffer->_pwent_size <=
422                 PERL_REENTRANT_MAXSIZE / 2)
423 #endif
424             {
425                 Uid_t uid;
426                 PL_reentrant_buffer->_pwent_size *= 2;
427                 Renew(PL_reentrant_buffer->_pwent_buffer,
428                       PL_reentrant_buffer->_pwent_size, char);
429                 switch (PL_op->op_type) {
430                 case OP_GPWNAM:
431                     p0 = va_arg(ap, void *);
432                     retptr = getpwnam(p0); break;
433                 case OP_GPWUID:
434                     uid = va_arg(ap, Uid_t);
435                     retptr = getpwuid(uid); break;
436                 case OP_GPWENT:
437                     retptr = getpwent(); break;
438                 default:
439                     SETERRNO(ERANGE, LIB_INVARG);
440                     break;
441                 }
442             }
443         }
444         break;
445 #endif
446 #ifdef USE_PROTOENT_BUFFER
447     case OP_GPBYNAME:
448     case OP_GPBYNUMBER:
449     case OP_GPROTOENT:
450         {
451 #ifdef PERL_REENTRANT_MAXSIZE
452             if (PL_reentrant_buffer->_protoent_size <=
453                 PERL_REENTRANT_MAXSIZE / 2)
454 #endif
455             {
456                 PL_reentrant_buffer->_protoent_size *= 2;
457                 Renew(PL_reentrant_buffer->_protoent_buffer,
458                       PL_reentrant_buffer->_protoent_size, char);
459                 switch (PL_op->op_type) {
460                 case OP_GPBYNAME:
461                     p0 = va_arg(ap, void *);
462                     retptr = getprotobyname(p0); break;
463                 case OP_GPBYNUMBER:
464                     anint = va_arg(ap, int);
465                     retptr = getprotobynumber(anint); break;
466                 case OP_GPROTOENT:
467                     retptr = getprotoent(); break;
468                 default:
469                     SETERRNO(ERANGE, LIB_INVARG);
470                     break;
471                 }
472             }
473         }
474         break;
475 #endif
476 #ifdef USE_SERVENT_BUFFER
477     case OP_GSBYNAME:
478     case OP_GSBYPORT:
479     case OP_GSERVENT:
480         {
481 #ifdef PERL_REENTRANT_MAXSIZE
482             if (PL_reentrant_buffer->_servent_size <=
483                 PERL_REENTRANT_MAXSIZE / 2)
484 #endif
485             {
486                 PL_reentrant_buffer->_servent_size *= 2;
487                 Renew(PL_reentrant_buffer->_servent_buffer,
488                       PL_reentrant_buffer->_servent_size, char);
489                 switch (PL_op->op_type) {
490                 case OP_GSBYNAME:
491                     p0 = va_arg(ap, void *);
492                     p1 = va_arg(ap, void *);
493                     retptr = getservbyname(p0, p1); break;
494                 case OP_GSBYPORT:
495                     anint = va_arg(ap, int);
496                     p0 = va_arg(ap, void *);
497                     retptr = getservbyport(anint, p0); break;
498                 case OP_GSERVENT:
499                     retptr = getservent(); break;
500                 default:
501                     SETERRNO(ERANGE, LIB_INVARG);
502                     break;
503                 }
504             }
505         }
506         break;
507 #endif
508     default:
509         /* Not known how to retry, so just fail. */
510         break;
511     }
512
513     va_end(ap);
514 #endif
515     return retptr;
516 }
517