X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=reentr.pl;h=b90c61dcfc4479523ba1bdab0c3472788e9d746d;hb=157ebcf587b4b84c105e6157097a480172b5079d;hp=b2a6b917f6fc38428f66b4a9f88f4883c3911878;hpb=1b6e066887bd14a26bc2e378007ac692eb28631b;p=p5sagit%2Fp5-mst-13.2.git diff --git a/reentr.pl b/reentr.pl index b2a6b91..b90c61d 100644 --- a/reentr.pl +++ b/reentr.pl @@ -1,14 +1,30 @@ #!/usr/bin/perl -w - -# -# Generate the reentr.c and reentr.h, -# and optionally also the relevant metaconfig units (-U option). # +# Regenerate (overwriting only if changed): +# +# reentr.h +# reentr.c +# +# from information stored in the DATA section of this file. +# +# With the -U option, it also unconditionally regenerates the relevant +# metaconfig units: +# +# d_${func}_r.U +# +# Also accepts the standard regen_lib -q and -v args. +# +# This script is normally invoked from regen.pl. + +BEGIN { + # Get function prototypes + require 'regen_lib.pl'; +} use strict; use Getopt::Std; my %opts; -getopts('U', \%opts); +getopts('Uv', \%opts); my %map = ( V => "void", @@ -35,23 +51,40 @@ my %map = ( # Example #3: S_CBI means type func_r(const char*, char*, int) -die "reentr.h: $!" unless open(H, ">reentr.h"); -select H; +# safer_unlink 'reentr.h'; +my $h = safer_open("reentr.h-new"); +select $h; print <. + */ + +#ifndef PERL_REENTR_API +# if defined(PERL_CORE) || defined(PERL_EXT) +# define PERL_REENTR_API 1 +# else +# define PERL_REENTR_API 0 +# endif +#endif #ifdef USE_REENTRANT_API @@ -59,7 +92,8 @@ print <) { # Read in the protypes. @@ -164,6 +210,7 @@ while () { # Read in the protypes. # If given the -U option open up the metaconfig unit for this function. if ($opts{U} && open(U, ">d_${func}_r.U")) { + binmode U; select U; } @@ -188,7 +235,7 @@ while () { # Read in the protypes. print <_${func}_buffer, PL_reentrant_buffer->_${func}_size, char); + Newx(PL_reentrant_buffer->_${func}_buffer, PL_reentrant_buffer->_${func}_size, char); EOF push @free, <_${func}_buffer); @@ -363,6 +411,7 @@ EOF EOF } } + return if @F == 1; push @define, <_${func}_struct.initialized = 0; - /* work around glibc-2.2.5 bug */ - PL_reentrant_buffer->_${func}_struct.current_saltbits = 0; +#if CRYPT_R_PROTO != REENTRANT_PROTO_B_CCD + PL_reentrant_buffer->_${func}_struct_buffer = 0; +#endif +EOF + push @free, <_${func}_struct_buffer); #endif EOF pushssif $endif; } - elsif ($func =~ /^(drand48|gmtime|localtime|random)$/) { + elsif ($func =~ /^(drand48|random|srandom)$/) { pushssif $ifdef; push @struct, <_${genfunc}_size = 1024; -EOF - } else { - push @struct, <_${genfunc}_fptr = NULL; # endif EOF - my $sc = $genfunc eq 'getgrent' ? + my $sc = $genfunc eq 'grent' ? '_SC_GETGR_R_SIZE_MAX' : '_SC_GETPW_R_SIZE_MAX'; - my $sz = $genfunc eq 'getgrent' ? - '_grent_size' : '_pwent_size'; - push @size, <_${genfunc}_size = sysconf($sc); - if (PL_reentrant_buffer->$sz == -1) + PL_reentrant_buffer->$sz = sysconf($sc); + if (PL_reentrant_buffer->$sz == (size_t) -1) PL_reentrant_buffer->$sz = REENTRANTUSUALSIZE; # else # if defined(__osf__) && defined(__alpha) && defined(SIABUFSIZ) - PL_reentrant_buffer->_${genfunc}_size = SIABUFSIZ; + PL_reentrant_buffer->$sz = SIABUFSIZ; # else # ifdef __sgi - PL_reentrant_buffer->_${genfunc}_size = BUFSIZ; + PL_reentrant_buffer->$sz = BUFSIZ; # else - PL_reentrant_buffer->_${genfunc}_size = REENTRANTUSUALSIZE; + PL_reentrant_buffer->$sz = REENTRANTUSUALSIZE; # endif # endif # endif EOF - } pushinitfree $genfunc; pushssif $endif; } @@ -566,7 +623,7 @@ EOF EOF push @init, <_${genfunc}_buffer, PL_reentrant_buffer->_${genfunc}_size, char); + Newx(PL_reentrant_buffer->_${genfunc}_buffer, PL_reentrant_buffer->_${genfunc}_size, char); #endif EOF push @free, <_${genfunc}_data" : $_ eq 'S' ? - ($func =~ /^readdir/ ? + ($func =~ /^readdir\d*$/ ? "PL_reentrant_buffer->_${genfunc}_struct" : - "&PL_reentrant_buffer->_${genfunc}_struct" ) : + $func =~ /^crypt$/ ? + "PL_reentrant_buffer->_${genfunc}_struct_buffer" : + "&PL_reentrant_buffer->_${genfunc}_struct") : $_ eq 'T' && $func eq 'drand48' ? "&PL_reentrant_buffer->_${genfunc}_double" : + $_ =~ /^[ilt]$/ && $func eq 'random' ? + "&PL_reentrant_buffer->_random_retval" : $_ } split '', $b; $w = ", $w" if length $v; } + my $call = "${func}_r($v$w)"; - $call = "((errno = $call))" if $r eq 'I'; + + # Must make OpenBSD happy + my $memzero = ''; + if($p =~ /D$/ && + ($genfunc eq 'protoent' || $genfunc eq 'servent')) { + $memzero = 'REENTR_MEMZERO(&PL_reentrant_buffer->_' . $genfunc . '_data, sizeof(PL_reentrant_buffer->_' . $genfunc . '_data)),'; + } push @wrap, <reentr.c"); -select C; +# safer_unlink 'reentr.c'; +my $c = safer_open("reentr.c-new"); +select $c; print <op_type) { #ifdef USE_HOSTENT_BUFFER @@ -796,7 +891,11 @@ Perl_reentrant_retry(const char *f, ...) case OP_GHBYNAME: case OP_GHOSTENT: { - if (PL_reentrant_buffer->_hostent_size <= REENTRANTHALFMAXSIZE) { +#ifdef PERL_REENTRANT_MAXSIZE + if (PL_reentrant_buffer->_hostent_size <= + PERL_REENTRANT_MAXSIZE / 2) +#endif + { PL_reentrant_buffer->_hostent_size *= 2; Renew(PL_reentrant_buffer->_hostent_buffer, PL_reentrant_buffer->_hostent_size, char); @@ -808,10 +907,11 @@ Perl_reentrant_retry(const char *f, ...) retptr = gethostbyaddr(p0, asize, anint); break; case OP_GHBYNAME: p0 = va_arg(ap, void *); - retptr = gethostbyname(p0); break; + retptr = gethostbyname((char *)p0); break; case OP_GHOSTENT: retptr = gethostent(); break; default: + SETERRNO(ERANGE, LIB_INVARG); break; } } @@ -823,7 +923,11 @@ Perl_reentrant_retry(const char *f, ...) case OP_GGRGID: case OP_GGRENT: { - if (PL_reentrant_buffer->_grent_size <= REENTRANTHALFMAXSIZE) { +#ifdef PERL_REENTRANT_MAXSIZE + if (PL_reentrant_buffer->_grent_size <= + PERL_REENTRANT_MAXSIZE / 2) +#endif + { Gid_t gid; PL_reentrant_buffer->_grent_size *= 2; Renew(PL_reentrant_buffer->_grent_buffer, @@ -831,13 +935,18 @@ Perl_reentrant_retry(const char *f, ...) switch (PL_op->op_type) { case OP_GGRNAM: p0 = va_arg(ap, void *); - retptr = getgrnam(p0); break; + retptr = getgrnam((char *)p0); break; case OP_GGRGID: +#if Gid_t_size < INTSIZE + gid = (Gid_t)va_arg(ap, int); +#else gid = va_arg(ap, Gid_t); +#endif retptr = getgrgid(gid); break; case OP_GGRENT: retptr = getgrent(); break; default: + SETERRNO(ERANGE, LIB_INVARG); break; } } @@ -849,7 +958,11 @@ Perl_reentrant_retry(const char *f, ...) case OP_GNBYNAME: case OP_GNETENT: { - if (PL_reentrant_buffer->_netent_size <= REENTRANTHALFMAXSIZE) { +#ifdef PERL_REENTRANT_MAXSIZE + if (PL_reentrant_buffer->_netent_size <= + PERL_REENTRANT_MAXSIZE / 2) +#endif + { Netdb_net_t net; PL_reentrant_buffer->_netent_size *= 2; Renew(PL_reentrant_buffer->_netent_buffer, @@ -861,10 +974,11 @@ Perl_reentrant_retry(const char *f, ...) retptr = getnetbyaddr(net, anint); break; case OP_GNBYNAME: p0 = va_arg(ap, void *); - retptr = getnetbyname(p0); break; + retptr = getnetbyname((char *)p0); break; case OP_GNETENT: retptr = getnetent(); break; default: + SETERRNO(ERANGE, LIB_INVARG); break; } } @@ -876,7 +990,11 @@ Perl_reentrant_retry(const char *f, ...) case OP_GPWUID: case OP_GPWENT: { - if (PL_reentrant_buffer->_pwent_size <= REENTRANTHALFMAXSIZE) { +#ifdef PERL_REENTRANT_MAXSIZE + if (PL_reentrant_buffer->_pwent_size <= + PERL_REENTRANT_MAXSIZE / 2) +#endif + { Uid_t uid; PL_reentrant_buffer->_pwent_size *= 2; Renew(PL_reentrant_buffer->_pwent_buffer, @@ -884,13 +1002,18 @@ Perl_reentrant_retry(const char *f, ...) switch (PL_op->op_type) { case OP_GPWNAM: p0 = va_arg(ap, void *); - retptr = getpwnam(p0); break; + retptr = getpwnam((char *)p0); break; case OP_GPWUID: +#if Uid_t_size < INTSIZE + uid = (Uid_t)va_arg(ap, int); +#else uid = va_arg(ap, Uid_t); +#endif retptr = getpwuid(uid); break; case OP_GPWENT: retptr = getpwent(); break; default: + SETERRNO(ERANGE, LIB_INVARG); break; } } @@ -902,20 +1025,25 @@ Perl_reentrant_retry(const char *f, ...) case OP_GPBYNUMBER: case OP_GPROTOENT: { - if (PL_reentrant_buffer->_protoent_size <= REENTRANTHALFMAXSIZE) { +#ifdef PERL_REENTRANT_MAXSIZE + if (PL_reentrant_buffer->_protoent_size <= + PERL_REENTRANT_MAXSIZE / 2) +#endif + { PL_reentrant_buffer->_protoent_size *= 2; Renew(PL_reentrant_buffer->_protoent_buffer, PL_reentrant_buffer->_protoent_size, char); switch (PL_op->op_type) { case OP_GPBYNAME: p0 = va_arg(ap, void *); - retptr = getprotobyname(p0); break; + retptr = getprotobyname((char *)p0); break; case OP_GPBYNUMBER: anint = va_arg(ap, int); retptr = getprotobynumber(anint); break; case OP_GPROTOENT: retptr = getprotoent(); break; default: + SETERRNO(ERANGE, LIB_INVARG); break; } } @@ -927,7 +1055,11 @@ Perl_reentrant_retry(const char *f, ...) case OP_GSBYPORT: case OP_GSERVENT: { - if (PL_reentrant_buffer->_servent_size <= REENTRANTHALFMAXSIZE) { +#ifdef PERL_REENTRANT_MAXSIZE + if (PL_reentrant_buffer->_servent_size <= + PERL_REENTRANT_MAXSIZE / 2) +#endif + { PL_reentrant_buffer->_servent_size *= 2; Renew(PL_reentrant_buffer->_servent_buffer, PL_reentrant_buffer->_servent_size, char); @@ -935,14 +1067,15 @@ Perl_reentrant_retry(const char *f, ...) case OP_GSBYNAME: p0 = va_arg(ap, void *); p1 = va_arg(ap, void *); - retptr = getservbyname(p0, p1); break; + retptr = getservbyname((char *)p0, (char *)p1); break; case OP_GSBYPORT: anint = va_arg(ap, int); p0 = va_arg(ap, void *); - retptr = getservbyport(anint, p0); break; + retptr = getservbyport(anint, (char *)p0); break; case OP_GSERVENT: retptr = getservent(); break; default: + SETERRNO(ERANGE, LIB_INVARG); break; } } @@ -953,14 +1086,20 @@ Perl_reentrant_retry(const char *f, ...) /* Not known how to retry, so just fail. */ break; } - - va_end(ap); +#else + PERL_UNUSED_ARG(f); #endif + } + va_end(ap); return retptr; } +/* ex: set ro: */ EOF +safer_close($c); +rename_if_different('reentr.c-new', 'reentr.c'); + __DATA__ asctime S |time |const struct tm|B_SB|B_SBI|I_SB|I_SBI crypt CC |crypt |struct crypt_data|B_CCS|B_CCD|D=CRYPTD* @@ -976,11 +1115,11 @@ endservent |netdb | |I_D|V_D|D=struct servent_data* getgrent |grp |struct group |I_SBWR|I_SBIR|S_SBW|S_SBI|I_SBI|I_SBIH getgrgid T |grp |struct group |I_TSBWR|I_TSBIR|I_TSBI|S_TSBI|T=gid_t getgrnam C |grp |struct group |I_CSBWR|I_CSBIR|S_CBI|I_CSBI|S_CSBI -gethostbyaddr CWI |netdb |struct hostent |I_CWISBWRE|S_CWISBWIE|S_CWISBIE|S_TWISBIE|S_CIISBIE|S_CSBIE|S_TSBIE|I_CWISD|I_CIISD|I_CII|D=struct hostent_data*|T=const void* +gethostbyaddr CWI |netdb |struct hostent |I_CWISBWRE|S_CWISBWIE|S_CWISBIE|S_TWISBIE|S_CIISBIE|S_CSBIE|S_TSBIE|I_CWISD|I_CIISD|I_CII|I_TsISBWRE|D=struct hostent_data*|T=const void*|s=socklen_t gethostbyname C |netdb |struct hostent |I_CSBWRE|S_CSBIE|I_CSD|D=struct hostent_data* gethostent |netdb |struct hostent |I_SBWRE|I_SBIE|S_SBIE|S_SBI|I_SBI|I_SD|D=struct hostent_data* -getlogin |unistd | |I_BW|I_BI|B_BW|B_BI -getnetbyaddr LI |netdb |struct netent |I_UISBWRE|I_LISBI|S_TISBI|S_LISBI|I_TISD|I_LISD|I_IISD|D=struct netent_data*|T=in_addr_t|U=unsigned long +getlogin |unistd |char |I_BW|I_BI|B_BW|B_BI +getnetbyaddr LI |netdb |struct netent |I_UISBWRE|I_LISBI|S_TISBI|S_LISBI|I_TISD|I_LISD|I_IISD|I_uISBWRE|D=struct netent_data*|T=in_addr_t|U=unsigned long|u=uint32_t getnetbyname C |netdb |struct netent |I_CSBWRE|I_CSBI|S_CSBI|I_CSD|D=struct netent_data* getnetent |netdb |struct netent |I_SBWRE|I_SBIE|S_SBIE|S_SBI|I_SBI|I_SD|D=struct netent_data* getprotobyname C|netdb |struct protoent|I_CSBWR|S_CSBI|I_CSD|D=struct protoent_data* @@ -993,9 +1132,7 @@ getservbyname CC|netdb |struct servent |I_CCSBWR|S_CCSBI|I_CCSD|D=struct servent getservbyport IC|netdb |struct servent |I_ICSBWR|S_ICSBI|I_ICSD|D=struct servent_data* getservent |netdb |struct servent |I_SBWR|I_SBI|S_SBI|I_SD|D=struct servent_data* getspnam C |shadow |struct spwd |I_CSBWR|S_CSBI -gmtime T |time |struct tm |S_TS|I_TS|T=const time_t* -localtime T |time |struct tm |S_TS|I_TS|T=const time_t* -random |stdlib |struct random_data|I_TS|T=int* +random |stdlib |struct random_data|I_iS|I_lS|I_St|i=int*|l=long*|t=int32_t* readdir T |dirent |struct dirent |I_TSR|I_TS|T=DIR* readdir64 T |dirent |struct dirent64|I_TSR|I_TS|T=DIR* setgrent |grp | |I_H|V_H