This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Removal of duplicate comment block
[perl5.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_GETPW_R_SIZE_MAX) && !defined(__GLIBC__)
39         PL_reentrant_buffer->_grent_size = sysconf(_SC_GETPW_R_SIZE_MAX);
40         if (PL_reentrant_buffer->_pwent_size == -1)
41                 PL_reentrant_buffer->_pwent_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->_pwent_size == -1)
98                 PL_reentrant_buffer->_pwent_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                     break;
346                 }
347             }
348             SETERRNO(ERANGE, LIB_INVARG);
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                     break;
377                 }
378             }
379             SETERRNO(ERANGE, LIB_INVARG);
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                     break;
409                 }
410             }
411             SETERRNO(ERANGE, LIB_INVARG);
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                     break;
440                 }
441             }
442         }
443         break;
444 #endif
445 #ifdef USE_PROTOENT_BUFFER
446     case OP_GPBYNAME:
447     case OP_GPBYNUMBER:
448     case OP_GPROTOENT:
449         {
450 #ifdef PERL_REENTRANT_MAXSIZE
451             if (PL_reentrant_buffer->_protoent_size <=
452                 PERL_REENTRANT_MAXSIZE / 2)
453 #endif
454             {
455                 PL_reentrant_buffer->_protoent_size *= 2;
456                 Renew(PL_reentrant_buffer->_protoent_buffer,
457                       PL_reentrant_buffer->_protoent_size, char);
458                 switch (PL_op->op_type) {
459                 case OP_GPBYNAME:
460                     p0 = va_arg(ap, void *);
461                     retptr = getprotobyname(p0); break;
462                 case OP_GPBYNUMBER:
463                     anint = va_arg(ap, int);
464                     retptr = getprotobynumber(anint); break;
465                 case OP_GPROTOENT:
466                     retptr = getprotoent(); break;
467                 default:
468                     break;
469                 }
470             }
471             SETERRNO(ERANGE, LIB_INVARG);
472         }
473         break;
474 #endif
475 #ifdef USE_SERVENT_BUFFER
476     case OP_GSBYNAME:
477     case OP_GSBYPORT:
478     case OP_GSERVENT:
479         {
480 #ifdef PERL_REENTRANT_MAXSIZE
481             if (PL_reentrant_buffer->_servent_size <=
482                 PERL_REENTRANT_MAXSIZE / 2)
483 #endif
484             {
485                 PL_reentrant_buffer->_servent_size *= 2;
486                 Renew(PL_reentrant_buffer->_servent_buffer,
487                       PL_reentrant_buffer->_servent_size, char);
488                 switch (PL_op->op_type) {
489                 case OP_GSBYNAME:
490                     p0 = va_arg(ap, void *);
491                     p1 = va_arg(ap, void *);
492                     retptr = getservbyname(p0, p1); break;
493                 case OP_GSBYPORT:
494                     anint = va_arg(ap, int);
495                     p0 = va_arg(ap, void *);
496                     retptr = getservbyport(anint, p0); break;
497                 case OP_GSERVENT:
498                     retptr = getservent(); break;
499                 default:
500                     break;
501                 }
502             }
503             SETERRNO(ERANGE, LIB_INVARG);
504         }
505         break;
506 #endif
507     default:
508         /* Not known how to retry, so just fail. */
509         break;
510     }
511
512     va_end(ap);
513 #endif
514     return retptr;
515 }
516