| [3181] | 1 | #!/usr/bin/perl -w
|
|---|
| 2 |
|
|---|
| 3 | #
|
|---|
| 4 | # Generate the reentr.c and reentr.h,
|
|---|
| 5 | # and optionally also the relevant metaconfig units (-U option).
|
|---|
| 6 | #
|
|---|
| 7 |
|
|---|
| 8 | BEGIN {
|
|---|
| 9 | # Get function prototypes
|
|---|
| 10 | require 'regen_lib.pl';
|
|---|
| 11 | }
|
|---|
| 12 |
|
|---|
| 13 | use strict;
|
|---|
| 14 | use Getopt::Std;
|
|---|
| 15 | my %opts;
|
|---|
| 16 | getopts('U', \%opts);
|
|---|
| 17 |
|
|---|
| 18 | my %map = (
|
|---|
| 19 | V => "void",
|
|---|
| 20 | A => "char*", # as an input argument
|
|---|
| 21 | B => "char*", # as an output argument
|
|---|
| 22 | C => "const char*", # as a read-only input argument
|
|---|
| 23 | I => "int",
|
|---|
| 24 | L => "long",
|
|---|
| 25 | W => "size_t",
|
|---|
| 26 | H => "FILE**",
|
|---|
| 27 | E => "int*",
|
|---|
| 28 | );
|
|---|
| 29 |
|
|---|
| 30 | # (See the definitions after __DATA__.)
|
|---|
| 31 | # In func|inc|type|... a "S" means "type*", and a "R" means "type**".
|
|---|
| 32 | # (The "types" are often structs, such as "struct passwd".)
|
|---|
| 33 | #
|
|---|
| 34 | # After the prototypes one can have |X=...|Y=... to define more types.
|
|---|
| 35 | # A commonly used extra type is to define D to be equal to "type_data",
|
|---|
| 36 | # for example "struct_hostent_data to" go with "struct hostent".
|
|---|
| 37 | #
|
|---|
| 38 | # Example #1: I_XSBWR means int func_r(X, type, char*, size_t, type**)
|
|---|
| 39 | # Example #2: S_SBIE means type func_r(type, char*, int, int*)
|
|---|
| 40 | # Example #3: S_CBI means type func_r(const char*, char*, int)
|
|---|
| 41 |
|
|---|
| 42 |
|
|---|
| 43 | safer_unlink 'reentr.h';
|
|---|
| 44 | die "reentr.h: $!" unless open(H, ">reentr.h");
|
|---|
| 45 | binmode H;
|
|---|
| 46 | select H;
|
|---|
| 47 | print <<EOF;
|
|---|
| 48 | /* -*- buffer-read-only: t -*-
|
|---|
| 49 | *
|
|---|
| 50 | * reentr.h
|
|---|
| 51 | *
|
|---|
| 52 | * Copyright (C) 2002, 2003, 2005, 2006 by Larry Wall and others
|
|---|
| 53 | *
|
|---|
| 54 | * You may distribute under the terms of either the GNU General Public
|
|---|
| 55 | * License or the Artistic License, as specified in the README file.
|
|---|
| 56 | *
|
|---|
| 57 | * !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
|
|---|
| 58 | * This file is built by reentr.pl from data in reentr.pl.
|
|---|
| 59 | */
|
|---|
| 60 |
|
|---|
| 61 | #ifndef REENTR_H
|
|---|
| 62 | #define REENTR_H
|
|---|
| 63 |
|
|---|
| 64 | #ifdef USE_REENTRANT_API
|
|---|
| 65 |
|
|---|
| 66 | #ifdef PERL_CORE
|
|---|
| 67 | # define PL_REENTRANT_RETINT PL_reentrant_retint
|
|---|
| 68 | #endif
|
|---|
| 69 |
|
|---|
| 70 | /* Deprecations: some platforms have the said reentrant interfaces
|
|---|
| 71 | * but they are declared obsolete and are not to be used. Often this
|
|---|
| 72 | * means that the platform has threadsafed the interfaces (hopefully).
|
|---|
| 73 | * All this is OS version dependent, so we are of course fooling ourselves.
|
|---|
| 74 | * If you know of more deprecations on some platforms, please add your own. */
|
|---|
| 75 |
|
|---|
| 76 | #ifdef __hpux
|
|---|
| 77 | # undef HAS_CRYPT_R
|
|---|
| 78 | # undef HAS_DRAND48_R
|
|---|
| 79 | # undef HAS_ENDGRENT_R
|
|---|
| 80 | # undef HAS_ENDPWENT_R
|
|---|
| 81 | # undef HAS_GETGRENT_R
|
|---|
| 82 | # undef HAS_GETPWENT_R
|
|---|
| 83 | # undef HAS_SETLOCALE_R
|
|---|
| 84 | # undef HAS_SRAND48_R
|
|---|
| 85 | # undef HAS_STRERROR_R
|
|---|
| 86 | # define NETDB_R_OBSOLETE
|
|---|
| 87 | #endif
|
|---|
| 88 |
|
|---|
| 89 | #if defined(__osf__) && defined(__alpha) /* Tru64 aka Digital UNIX */
|
|---|
| 90 | # undef HAS_CRYPT_R
|
|---|
| 91 | # undef HAS_STRERROR_R
|
|---|
| 92 | # define NETDB_R_OBSOLETE
|
|---|
| 93 | #endif
|
|---|
| 94 |
|
|---|
| 95 | #ifdef NETDB_R_OBSOLETE
|
|---|
| 96 | # undef HAS_ENDHOSTENT_R
|
|---|
| 97 | # undef HAS_ENDNETENT_R
|
|---|
| 98 | # undef HAS_ENDPROTOENT_R
|
|---|
| 99 | # undef HAS_ENDSERVENT_R
|
|---|
| 100 | # undef HAS_GETHOSTBYADDR_R
|
|---|
| 101 | # undef HAS_GETHOSTBYNAME_R
|
|---|
| 102 | # undef HAS_GETHOSTENT_R
|
|---|
| 103 | # undef HAS_GETNETBYADDR_R
|
|---|
| 104 | # undef HAS_GETNETBYNAME_R
|
|---|
| 105 | # undef HAS_GETNETENT_R
|
|---|
| 106 | # undef HAS_GETPROTOBYNAME_R
|
|---|
| 107 | # undef HAS_GETPROTOBYNUMBER_R
|
|---|
| 108 | # undef HAS_GETPROTOENT_R
|
|---|
| 109 | # undef HAS_GETSERVBYNAME_R
|
|---|
| 110 | # undef HAS_GETSERVBYPORT_R
|
|---|
| 111 | # undef HAS_GETSERVENT_R
|
|---|
| 112 | # undef HAS_SETHOSTENT_R
|
|---|
| 113 | # undef HAS_SETNETENT_R
|
|---|
| 114 | # undef HAS_SETPROTOENT_R
|
|---|
| 115 | # undef HAS_SETSERVENT_R
|
|---|
| 116 | #endif
|
|---|
| 117 |
|
|---|
| 118 | #ifdef I_PWD
|
|---|
| 119 | # include <pwd.h>
|
|---|
| 120 | #endif
|
|---|
| 121 | #ifdef I_GRP
|
|---|
| 122 | # include <grp.h>
|
|---|
| 123 | #endif
|
|---|
| 124 | #ifdef I_NETDB
|
|---|
| 125 | # include <netdb.h>
|
|---|
| 126 | #endif
|
|---|
| 127 | #ifdef I_STDLIB
|
|---|
| 128 | # include <stdlib.h> /* drand48_data */
|
|---|
| 129 | #endif
|
|---|
| 130 | #ifdef I_CRYPT
|
|---|
| 131 | # ifdef I_CRYPT
|
|---|
| 132 | # include <crypt.h>
|
|---|
| 133 | # endif
|
|---|
| 134 | #endif
|
|---|
| 135 | #ifdef HAS_GETSPNAM_R
|
|---|
| 136 | # ifdef I_SHADOW
|
|---|
| 137 | # include <shadow.h>
|
|---|
| 138 | # endif
|
|---|
| 139 | #endif
|
|---|
| 140 |
|
|---|
| 141 | EOF
|
|---|
| 142 |
|
|---|
| 143 | my %seenh; # the different prototypes signatures for this function
|
|---|
| 144 | my %seena; # the different prototypes signatures for this function in order
|
|---|
| 145 | my @seenf; # all the seen functions
|
|---|
| 146 | my %seenp; # the different prototype signatures for all functions
|
|---|
| 147 | my %seent; # the return type of this function
|
|---|
| 148 | my %seens; # the type of this function's "S"
|
|---|
| 149 | my %seend; # the type of this function's "D"
|
|---|
| 150 | my %seenm; # all the types
|
|---|
| 151 | my %seenu; # the length of the argument list of this function
|
|---|
| 152 | my %seenr; # the return type of this function
|
|---|
| 153 |
|
|---|
| 154 | while (<DATA>) { # Read in the protypes.
|
|---|
| 155 | next if /^\s+$/;
|
|---|
| 156 | chomp;
|
|---|
| 157 | my ($func, $hdr, $type, @p) = split(/\s*\|\s*/, $_, -1);
|
|---|
| 158 | my ($r,$u);
|
|---|
| 159 | # Split off the real function name and the argument list.
|
|---|
| 160 | ($func, $u) = split(' ', $func);
|
|---|
| 161 | $u = "V_V" unless $u;
|
|---|
| 162 | ($r, $u) = ($u =~ /^(.)_(.+)/);
|
|---|
| 163 | $seenu{$func} = $u eq 'V' ? 0 : length $u;
|
|---|
| 164 | $seenr{$func} = $r;
|
|---|
| 165 | my $FUNC = uc $func; # for output.
|
|---|
| 166 | push @seenf, $func;
|
|---|
| 167 | my %m = %map;
|
|---|
| 168 | if ($type) {
|
|---|
| 169 | $m{S} = "$type*";
|
|---|
| 170 | $m{R} = "$type**";
|
|---|
| 171 | }
|
|---|
| 172 |
|
|---|
| 173 | # Set any special mapping variables (like X=x_t)
|
|---|
| 174 | if (@p) {
|
|---|
| 175 | while ($p[-1] =~ /=/) {
|
|---|
| 176 | my ($k, $v) = ($p[-1] =~ /^([A-Za-z])\s*=\s*(.*)/);
|
|---|
| 177 | $m{$k} = $v;
|
|---|
| 178 | pop @p;
|
|---|
| 179 | }
|
|---|
| 180 | }
|
|---|
| 181 |
|
|---|
| 182 | # If given the -U option open up the metaconfig unit for this function.
|
|---|
| 183 | if ($opts{U} && open(U, ">d_${func}_r.U")) {
|
|---|
| 184 | binmode U;
|
|---|
| 185 | select U;
|
|---|
| 186 | }
|
|---|
| 187 |
|
|---|
| 188 | if ($opts{U}) {
|
|---|
| 189 | # The metaconfig units needs prerequisite dependencies.
|
|---|
| 190 | my $prereqs = '';
|
|---|
| 191 | my $prereqh = '';
|
|---|
| 192 | my $prereqsh = '';
|
|---|
| 193 | if ($hdr ne 'stdio') { # There's no i_stdio.
|
|---|
| 194 | $prereqs = "i_$hdr";
|
|---|
| 195 | $prereqh = "$hdr.h";
|
|---|
| 196 | $prereqsh = "\$$prereqs $prereqh";
|
|---|
| 197 | }
|
|---|
| 198 | my @prereq = qw(Inlibc Protochk Hasproto i_systypes usethreads);
|
|---|
| 199 | push @prereq, $prereqs;
|
|---|
| 200 | my $hdrs = "\$i_systypes sys/types.h define stdio.h $prereqsh";
|
|---|
| 201 | if ($hdr eq 'time') {
|
|---|
| 202 | $hdrs .= " \$i_systime sys/time.h";
|
|---|
| 203 | push @prereq, 'i_systime';
|
|---|
| 204 | }
|
|---|
| 205 | # Output the metaconfig unit header.
|
|---|
| 206 | print <<EOF;
|
|---|
| 207 | ?RCS: \$Id: d_${func}_r.U,v $
|
|---|
| 208 | ?RCS:
|
|---|
| 209 | ?RCS: Copyright (c) 2002,2003 Jarkko Hietaniemi
|
|---|
| 210 | ?RCS:
|
|---|
| 211 | ?RCS: You may distribute under the terms of either the GNU General Public
|
|---|
| 212 | ?RCS: License or the Artistic License, as specified in the README file.
|
|---|
| 213 | ?RCS:
|
|---|
| 214 | ?RCS: Generated by the reentr.pl from the Perl 5.8 distribution.
|
|---|
| 215 | ?RCS:
|
|---|
| 216 | ?MAKE:d_${func}_r ${func}_r_proto: @prereq
|
|---|
| 217 | ?MAKE: -pick add \$@ %<
|
|---|
| 218 | ?S:d_${func}_r:
|
|---|
| 219 | ?S: This variable conditionally defines the HAS_${FUNC}_R symbol,
|
|---|
| 220 | ?S: which indicates to the C program that the ${func}_r()
|
|---|
| 221 | ?S: routine is available.
|
|---|
| 222 | ?S:.
|
|---|
| 223 | ?S:${func}_r_proto:
|
|---|
| 224 | ?S: This variable encodes the prototype of ${func}_r.
|
|---|
| 225 | ?S: It is zero if d_${func}_r is undef, and one of the
|
|---|
| 226 | ?S: REENTRANT_PROTO_T_ABC macros of reentr.h if d_${func}_r
|
|---|
| 227 | ?S: is defined.
|
|---|
| 228 | ?S:.
|
|---|
| 229 | ?C:HAS_${FUNC}_R:
|
|---|
| 230 | ?C: This symbol, if defined, indicates that the ${func}_r routine
|
|---|
| 231 | ?C: is available to ${func} re-entrantly.
|
|---|
| 232 | ?C:.
|
|---|
| 233 | ?C:${FUNC}_R_PROTO:
|
|---|
| 234 | ?C: This symbol encodes the prototype of ${func}_r.
|
|---|
| 235 | ?C: It is zero if d_${func}_r is undef, and one of the
|
|---|
| 236 | ?C: REENTRANT_PROTO_T_ABC macros of reentr.h if d_${func}_r
|
|---|
| 237 | ?C: is defined.
|
|---|
| 238 | ?C:.
|
|---|
| 239 | ?H:#\$d_${func}_r HAS_${FUNC}_R /**/
|
|---|
| 240 | ?H:#define ${FUNC}_R_PROTO \$${func}_r_proto /**/
|
|---|
| 241 | ?H:.
|
|---|
| 242 | ?T:try hdrs d_${func}_r_proto
|
|---|
| 243 | ?LINT:set d_${func}_r
|
|---|
| 244 | ?LINT:set ${func}_r_proto
|
|---|
| 245 | : see if ${func}_r exists
|
|---|
| 246 | set ${func}_r d_${func}_r
|
|---|
| 247 | eval \$inlibc
|
|---|
| 248 | case "\$d_${func}_r" in
|
|---|
| 249 | "\$define")
|
|---|
| 250 | EOF
|
|---|
| 251 | print <<EOF;
|
|---|
| 252 | hdrs="$hdrs"
|
|---|
| 253 | case "\$d_${func}_r_proto:\$usethreads" in
|
|---|
| 254 | ":define") d_${func}_r_proto=define
|
|---|
| 255 | set d_${func}_r_proto ${func}_r \$hdrs
|
|---|
| 256 | eval \$hasproto ;;
|
|---|
| 257 | *) ;;
|
|---|
| 258 | esac
|
|---|
| 259 | case "\$d_${func}_r_proto" in
|
|---|
| 260 | define)
|
|---|
| 261 | EOF
|
|---|
| 262 | }
|
|---|
| 263 | for my $p (@p) {
|
|---|
| 264 | my ($r, $a) = ($p =~ /^(.)_(.+)/);
|
|---|
| 265 | my $v = join(", ", map { $m{$_} } split '', $a);
|
|---|
| 266 | if ($opts{U}) {
|
|---|
| 267 | print <<EOF ;
|
|---|
| 268 | case "\$${func}_r_proto" in
|
|---|
| 269 | ''|0) try='$m{$r} ${func}_r($v);'
|
|---|
| 270 | ./protochk "extern \$try" \$hdrs && ${func}_r_proto=$p ;;
|
|---|
| 271 | esac
|
|---|
| 272 | EOF
|
|---|
| 273 | }
|
|---|
| 274 | $seenh{$func}->{$p}++;
|
|---|
| 275 | push @{$seena{$func}}, $p;
|
|---|
| 276 | $seenp{$p}++;
|
|---|
| 277 | $seent{$func} = $type;
|
|---|
| 278 | $seens{$func} = $m{S};
|
|---|
| 279 | $seend{$func} = $m{D};
|
|---|
| 280 | $seenm{$func} = \%m;
|
|---|
| 281 | }
|
|---|
| 282 | if ($opts{U}) {
|
|---|
| 283 | print <<EOF;
|
|---|
| 284 | case "\$${func}_r_proto" in
|
|---|
| 285 | ''|0) d_${func}_r=undef
|
|---|
| 286 | ${func}_r_proto=0
|
|---|
| 287 | echo "Disabling ${func}_r, cannot determine prototype." >&4 ;;
|
|---|
| 288 | * ) case "\$${func}_r_proto" in
|
|---|
| 289 | REENTRANT_PROTO*) ;;
|
|---|
| 290 | *) ${func}_r_proto="REENTRANT_PROTO_\$${func}_r_proto" ;;
|
|---|
| 291 | esac
|
|---|
| 292 | echo "Prototype: \$try" ;;
|
|---|
| 293 | esac
|
|---|
| 294 | ;;
|
|---|
| 295 | *) case "\$usethreads" in
|
|---|
| 296 | define) echo "${func}_r has no prototype, not using it." >&4 ;;
|
|---|
| 297 | esac
|
|---|
| 298 | d_${func}_r=undef
|
|---|
| 299 | ${func}_r_proto=0
|
|---|
| 300 | ;;
|
|---|
| 301 | esac
|
|---|
| 302 | ;;
|
|---|
| 303 | *) ${func}_r_proto=0
|
|---|
| 304 | ;;
|
|---|
| 305 | esac
|
|---|
| 306 |
|
|---|
| 307 | EOF
|
|---|
| 308 | close(U);
|
|---|
| 309 | }
|
|---|
| 310 | }
|
|---|
| 311 |
|
|---|
| 312 | close DATA;
|
|---|
| 313 |
|
|---|
| 314 | # Prepare to continue writing the reentr.h.
|
|---|
| 315 |
|
|---|
| 316 | select H;
|
|---|
| 317 |
|
|---|
| 318 | {
|
|---|
| 319 | # Write out all the known prototype signatures.
|
|---|
| 320 | my $i = 1;
|
|---|
| 321 | for my $p (sort keys %seenp) {
|
|---|
| 322 | print "#define REENTRANT_PROTO_${p} ${i}\n";
|
|---|
| 323 | $i++;
|
|---|
| 324 | }
|
|---|
| 325 | }
|
|---|
| 326 |
|
|---|
| 327 | my @struct; # REENTR struct members
|
|---|
| 328 | my @size; # struct member buffer size initialization code
|
|---|
| 329 | my @init; # struct member buffer initialization (malloc) code
|
|---|
| 330 | my @free; # struct member buffer release (free) code
|
|---|
| 331 | my @wrap; # the wrapper (foo(a) -> foo_r(a,...)) cpp code
|
|---|
| 332 | my @define; # defines for optional features
|
|---|
| 333 |
|
|---|
| 334 | sub ifprotomatch {
|
|---|
| 335 | my $FUNC = shift;
|
|---|
| 336 | join " || ", map { "${FUNC}_R_PROTO == REENTRANT_PROTO_$_" } @_;
|
|---|
| 337 | }
|
|---|
| 338 |
|
|---|
| 339 | sub pushssif {
|
|---|
| 340 | push @struct, @_;
|
|---|
| 341 | push @size, @_;
|
|---|
| 342 | push @init, @_;
|
|---|
| 343 | push @free, @_;
|
|---|
| 344 | }
|
|---|
| 345 |
|
|---|
| 346 | sub pushinitfree {
|
|---|
| 347 | my $func = shift;
|
|---|
| 348 | push @init, <<EOF;
|
|---|
| 349 | Newx(PL_reentrant_buffer->_${func}_buffer, PL_reentrant_buffer->_${func}_size, char);
|
|---|
| 350 | EOF
|
|---|
| 351 | push @free, <<EOF;
|
|---|
| 352 | Safefree(PL_reentrant_buffer->_${func}_buffer);
|
|---|
| 353 | EOF
|
|---|
| 354 | }
|
|---|
| 355 |
|
|---|
| 356 | sub define {
|
|---|
| 357 | my ($n, $p, @F) = @_;
|
|---|
| 358 | my @H;
|
|---|
| 359 | my $H = uc $F[0];
|
|---|
| 360 | push @define, <<EOF;
|
|---|
| 361 | /* The @F using \L$n? */
|
|---|
| 362 |
|
|---|
| 363 | EOF
|
|---|
| 364 | my $GENFUNC;
|
|---|
| 365 | for my $func (@F) {
|
|---|
| 366 | my $FUNC = uc $func;
|
|---|
| 367 | my $HAS = "${FUNC}_R_HAS_$n";
|
|---|
| 368 | push @H, $HAS;
|
|---|
| 369 | my @h = grep { /$p/ } @{$seena{$func}};
|
|---|
| 370 | unless (defined $GENFUNC) {
|
|---|
| 371 | $GENFUNC = $FUNC;
|
|---|
| 372 | $GENFUNC =~ s/^GET//;
|
|---|
| 373 | }
|
|---|
| 374 | if (@h) {
|
|---|
| 375 | push @define, "#if defined(HAS_${FUNC}_R) && (" . join(" || ", map { "${FUNC}_R_PROTO == REENTRANT_PROTO_$_" } @h) . ")\n";
|
|---|
| 376 |
|
|---|
| 377 | push @define, <<EOF;
|
|---|
| 378 | # define $HAS
|
|---|
| 379 | #else
|
|---|
| 380 | # undef $HAS
|
|---|
| 381 | #endif
|
|---|
| 382 | EOF
|
|---|
| 383 | }
|
|---|
| 384 | }
|
|---|
| 385 | return if @F == 1;
|
|---|
| 386 | push @define, <<EOF;
|
|---|
| 387 |
|
|---|
| 388 | /* Any of the @F using \L$n? */
|
|---|
| 389 |
|
|---|
| 390 | EOF
|
|---|
| 391 | push @define, "#if (" . join(" || ", map { "defined($_)" } @H) . ")\n";
|
|---|
| 392 | push @define, <<EOF;
|
|---|
| 393 | # define USE_${GENFUNC}_$n
|
|---|
| 394 | #else
|
|---|
| 395 | # undef USE_${GENFUNC}_$n
|
|---|
| 396 | #endif
|
|---|
| 397 |
|
|---|
| 398 | EOF
|
|---|
| 399 | }
|
|---|
| 400 |
|
|---|
| 401 | define('BUFFER', 'B',
|
|---|
| 402 | qw(getgrent getgrgid getgrnam));
|
|---|
| 403 |
|
|---|
| 404 | define('PTR', 'R',
|
|---|
| 405 | qw(getgrent getgrgid getgrnam));
|
|---|
| 406 | define('PTR', 'R',
|
|---|
| 407 | qw(getpwent getpwnam getpwuid));
|
|---|
| 408 | define('PTR', 'R',
|
|---|
| 409 | qw(getspent getspnam));
|
|---|
| 410 |
|
|---|
| 411 | define('FPTR', 'H',
|
|---|
| 412 | qw(getgrent getgrgid getgrnam setgrent endgrent));
|
|---|
| 413 | define('FPTR', 'H',
|
|---|
| 414 | qw(getpwent getpwnam getpwuid setpwent endpwent));
|
|---|
| 415 |
|
|---|
| 416 | define('BUFFER', 'B',
|
|---|
| 417 | qw(getpwent getpwgid getpwnam));
|
|---|
| 418 |
|
|---|
| 419 | define('PTR', 'R',
|
|---|
| 420 | qw(gethostent gethostbyaddr gethostbyname));
|
|---|
| 421 | define('PTR', 'R',
|
|---|
| 422 | qw(getnetent getnetbyaddr getnetbyname));
|
|---|
| 423 | define('PTR', 'R',
|
|---|
| 424 | qw(getprotoent getprotobyname getprotobynumber));
|
|---|
| 425 | define('PTR', 'R',
|
|---|
| 426 | qw(getservent getservbyname getservbyport));
|
|---|
| 427 |
|
|---|
| 428 | define('BUFFER', 'B',
|
|---|
| 429 | qw(gethostent gethostbyaddr gethostbyname));
|
|---|
| 430 | define('BUFFER', 'B',
|
|---|
| 431 | qw(getnetent getnetbyaddr getnetbyname));
|
|---|
| 432 | define('BUFFER', 'B',
|
|---|
| 433 | qw(getprotoent getprotobyname getprotobynumber));
|
|---|
| 434 | define('BUFFER', 'B',
|
|---|
| 435 | qw(getservent getservbyname getservbyport));
|
|---|
| 436 |
|
|---|
| 437 | define('ERRNO', 'E',
|
|---|
| 438 | qw(gethostent gethostbyaddr gethostbyname));
|
|---|
| 439 | define('ERRNO', 'E',
|
|---|
| 440 | qw(getnetent getnetbyaddr getnetbyname));
|
|---|
| 441 |
|
|---|
| 442 | # The following loop accumulates the "ssif" (struct, size, init, free)
|
|---|
| 443 | # sections that declare the struct members (in reentr.h), and the buffer
|
|---|
| 444 | # size initialization, buffer initialization (malloc), and buffer
|
|---|
| 445 | # release (free) code (in reentr.c).
|
|---|
| 446 | #
|
|---|
| 447 | # The loop also contains a lot of intrinsic logic about groups of
|
|---|
| 448 | # functions (since functions of certain kind operate the same way).
|
|---|
| 449 |
|
|---|
| 450 | for my $func (@seenf) {
|
|---|
| 451 | my $FUNC = uc $func;
|
|---|
| 452 | my $ifdef = "#ifdef HAS_${FUNC}_R\n";
|
|---|
| 453 | my $endif = "#endif /* HAS_${FUNC}_R */\n";
|
|---|
| 454 | if (exists $seena{$func}) {
|
|---|
| 455 | my @p = @{$seena{$func}};
|
|---|
| 456 | if ($func =~ /^(asctime|ctime|getlogin|setlocale|strerror|ttyname)$/) {
|
|---|
| 457 | pushssif $ifdef;
|
|---|
| 458 | push @struct, <<EOF;
|
|---|
| 459 | char* _${func}_buffer;
|
|---|
| 460 | size_t _${func}_size;
|
|---|
| 461 | EOF
|
|---|
| 462 | push @size, <<EOF;
|
|---|
| 463 | PL_reentrant_buffer->_${func}_size = REENTRANTSMALLSIZE;
|
|---|
| 464 | EOF
|
|---|
| 465 | pushinitfree $func;
|
|---|
| 466 | pushssif $endif;
|
|---|
| 467 | }
|
|---|
| 468 | elsif ($func =~ /^(crypt)$/) {
|
|---|
| 469 | pushssif $ifdef;
|
|---|
| 470 | push @struct, <<EOF;
|
|---|
| 471 | #if CRYPT_R_PROTO == REENTRANT_PROTO_B_CCD
|
|---|
| 472 | $seend{$func} _${func}_data;
|
|---|
| 473 | #else
|
|---|
| 474 | $seent{$func} _${func}_struct;
|
|---|
| 475 | #endif
|
|---|
| 476 | EOF
|
|---|
| 477 | push @init, <<EOF;
|
|---|
| 478 | #if CRYPT_R_PROTO != REENTRANT_PROTO_B_CCD
|
|---|
| 479 | PL_reentrant_buffer->_${func}_struct_buffer = 0;
|
|---|
| 480 | #endif
|
|---|
| 481 | EOF
|
|---|
| 482 | push @free, <<EOF;
|
|---|
| 483 | #if CRYPT_R_PROTO != REENTRANT_PROTO_B_CCD
|
|---|
| 484 | Safefree(PL_reentrant_buffer->_${func}_struct_buffer);
|
|---|
| 485 | #endif
|
|---|
| 486 | EOF
|
|---|
| 487 | pushssif $endif;
|
|---|
| 488 | }
|
|---|
| 489 | elsif ($func =~ /^(drand48|gmtime|localtime)$/) {
|
|---|
| 490 | pushssif $ifdef;
|
|---|
| 491 | push @struct, <<EOF;
|
|---|
| 492 | $seent{$func} _${func}_struct;
|
|---|
| 493 | EOF
|
|---|
| 494 | if ($1 eq 'drand48') {
|
|---|
| 495 | push @struct, <<EOF;
|
|---|
| 496 | double _${func}_double;
|
|---|
| 497 | EOF
|
|---|
| 498 | }
|
|---|
| 499 | pushssif $endif;
|
|---|
| 500 | }
|
|---|
| 501 | elsif ($func =~ /^random$/) {
|
|---|
| 502 | pushssif $ifdef;
|
|---|
| 503 | push @struct, <<EOF;
|
|---|
| 504 | # if RANDOM_R_PROTO != REENTRANT_PROTO_I_St
|
|---|
| 505 | $seent{$func} _${func}_struct;
|
|---|
| 506 | # endif
|
|---|
| 507 | EOF
|
|---|
| 508 | pushssif $endif;
|
|---|
| 509 | }
|
|---|
| 510 | elsif ($func =~ /^(getgrnam|getpwnam|getspnam)$/) {
|
|---|
| 511 | pushssif $ifdef;
|
|---|
| 512 | # 'genfunc' can be read either as 'generic' or 'genre',
|
|---|
| 513 | # it represents a group of functions.
|
|---|
| 514 | my $genfunc = $func;
|
|---|
| 515 | $genfunc =~ s/nam/ent/g;
|
|---|
| 516 | $genfunc =~ s/^get//;
|
|---|
| 517 | my $GENFUNC = uc $genfunc;
|
|---|
| 518 | push @struct, <<EOF;
|
|---|
| 519 | $seent{$func} _${genfunc}_struct;
|
|---|
| 520 | char* _${genfunc}_buffer;
|
|---|
| 521 | size_t _${genfunc}_size;
|
|---|
| 522 | EOF
|
|---|
| 523 | push @struct, <<EOF;
|
|---|
| 524 | # ifdef USE_${GENFUNC}_PTR
|
|---|
| 525 | $seent{$func}* _${genfunc}_ptr;
|
|---|
| 526 | # endif
|
|---|
| 527 | EOF
|
|---|
| 528 | push @struct, <<EOF;
|
|---|
| 529 | # ifdef USE_${GENFUNC}_FPTR
|
|---|
| 530 | FILE* _${genfunc}_fptr;
|
|---|
| 531 | # endif
|
|---|
| 532 | EOF
|
|---|
| 533 | push @init, <<EOF;
|
|---|
| 534 | # ifdef USE_${GENFUNC}_FPTR
|
|---|
| 535 | PL_reentrant_buffer->_${genfunc}_fptr = NULL;
|
|---|
| 536 | # endif
|
|---|
| 537 | EOF
|
|---|
| 538 | my $sc = $genfunc eq 'grent' ?
|
|---|
| 539 | '_SC_GETGR_R_SIZE_MAX' : '_SC_GETPW_R_SIZE_MAX';
|
|---|
| 540 | my $sz = "_${genfunc}_size";
|
|---|
| 541 | push @size, <<EOF;
|
|---|
| 542 | # if defined(HAS_SYSCONF) && defined($sc) && !defined(__GLIBC__)
|
|---|
| 543 | PL_reentrant_buffer->$sz = sysconf($sc);
|
|---|
| 544 | if (PL_reentrant_buffer->$sz == -1)
|
|---|
| 545 | PL_reentrant_buffer->$sz = REENTRANTUSUALSIZE;
|
|---|
| 546 | # else
|
|---|
| 547 | # if defined(__osf__) && defined(__alpha) && defined(SIABUFSIZ)
|
|---|
| 548 | PL_reentrant_buffer->$sz = SIABUFSIZ;
|
|---|
| 549 | # else
|
|---|
| 550 | # ifdef __sgi
|
|---|
| 551 | PL_reentrant_buffer->$sz = BUFSIZ;
|
|---|
| 552 | # else
|
|---|
| 553 | PL_reentrant_buffer->$sz = REENTRANTUSUALSIZE;
|
|---|
| 554 | # endif
|
|---|
| 555 | # endif
|
|---|
| 556 | # endif
|
|---|
| 557 | EOF
|
|---|
| 558 | pushinitfree $genfunc;
|
|---|
| 559 | pushssif $endif;
|
|---|
| 560 | }
|
|---|
| 561 | elsif ($func =~ /^(gethostbyname|getnetbyname|getservbyname|getprotobyname)$/) {
|
|---|
| 562 | pushssif $ifdef;
|
|---|
| 563 | my $genfunc = $func;
|
|---|
| 564 | $genfunc =~ s/byname/ent/;
|
|---|
| 565 | $genfunc =~ s/^get//;
|
|---|
| 566 | my $GENFUNC = uc $genfunc;
|
|---|
| 567 | my $D = ifprotomatch($FUNC, grep {/D/} @p);
|
|---|
| 568 | my $d = $seend{$func};
|
|---|
| 569 | $d =~ s/\*$//; # snip: we need need the base type.
|
|---|
| 570 | push @struct, <<EOF;
|
|---|
| 571 | $seent{$func} _${genfunc}_struct;
|
|---|
| 572 | # if $D
|
|---|
| 573 | $d _${genfunc}_data;
|
|---|
| 574 | # else
|
|---|
| 575 | char* _${genfunc}_buffer;
|
|---|
| 576 | size_t _${genfunc}_size;
|
|---|
| 577 | # endif
|
|---|
| 578 | # ifdef USE_${GENFUNC}_PTR
|
|---|
| 579 | $seent{$func}* _${genfunc}_ptr;
|
|---|
| 580 | # endif
|
|---|
| 581 | EOF
|
|---|
| 582 | push @struct, <<EOF;
|
|---|
| 583 | # ifdef USE_${GENFUNC}_ERRNO
|
|---|
| 584 | int _${genfunc}_errno;
|
|---|
| 585 | # endif
|
|---|
| 586 | EOF
|
|---|
| 587 | push @size, <<EOF;
|
|---|
| 588 | #if !($D)
|
|---|
| 589 | PL_reentrant_buffer->_${genfunc}_size = REENTRANTUSUALSIZE;
|
|---|
| 590 | #endif
|
|---|
| 591 | EOF
|
|---|
| 592 | push @init, <<EOF;
|
|---|
| 593 | #if !($D)
|
|---|
| 594 | Newx(PL_reentrant_buffer->_${genfunc}_buffer, PL_reentrant_buffer->_${genfunc}_size, char);
|
|---|
| 595 | #endif
|
|---|
| 596 | EOF
|
|---|
| 597 | push @free, <<EOF;
|
|---|
| 598 | #if !($D)
|
|---|
| 599 | Safefree(PL_reentrant_buffer->_${genfunc}_buffer);
|
|---|
| 600 | #endif
|
|---|
| 601 | EOF
|
|---|
| 602 | pushssif $endif;
|
|---|
| 603 | }
|
|---|
| 604 | elsif ($func =~ /^(readdir|readdir64)$/) {
|
|---|
| 605 | pushssif $ifdef;
|
|---|
| 606 | my $R = ifprotomatch($FUNC, grep {/R/} @p);
|
|---|
| 607 | push @struct, <<EOF;
|
|---|
| 608 | $seent{$func}* _${func}_struct;
|
|---|
| 609 | size_t _${func}_size;
|
|---|
| 610 | # if $R
|
|---|
| 611 | $seent{$func}* _${func}_ptr;
|
|---|
| 612 | # endif
|
|---|
| 613 | EOF
|
|---|
| 614 | push @size, <<EOF;
|
|---|
| 615 | /* This is the size Solaris recommends.
|
|---|
| 616 | * (though we go static, should use pathconf() instead) */
|
|---|
| 617 | PL_reentrant_buffer->_${func}_size = sizeof($seent{$func}) + MAXPATHLEN + 1;
|
|---|
| 618 | EOF
|
|---|
| 619 | push @init, <<EOF;
|
|---|
| 620 | PL_reentrant_buffer->_${func}_struct = ($seent{$func}*)safemalloc(PL_reentrant_buffer->_${func}_size);
|
|---|
| 621 | EOF
|
|---|
| 622 | push @free, <<EOF;
|
|---|
| 623 | Safefree(PL_reentrant_buffer->_${func}_struct);
|
|---|
| 624 | EOF
|
|---|
| 625 | pushssif $endif;
|
|---|
| 626 | }
|
|---|
| 627 |
|
|---|
| 628 | push @wrap, $ifdef;
|
|---|
| 629 |
|
|---|
| 630 | push @wrap, <<EOF;
|
|---|
| 631 | # undef $func
|
|---|
| 632 | EOF
|
|---|
| 633 |
|
|---|
| 634 | # Write out what we have learned.
|
|---|
| 635 |
|
|---|
| 636 | my @v = 'a'..'z';
|
|---|
| 637 | my $v = join(", ", @v[0..$seenu{$func}-1]);
|
|---|
| 638 | for my $p (@p) {
|
|---|
| 639 | my ($r, $a) = split '_', $p;
|
|---|
| 640 | my $test = $r eq 'I' ? ' == 0' : '';
|
|---|
| 641 | my $true = 1;
|
|---|
| 642 | my $genfunc = $func;
|
|---|
| 643 | if ($genfunc =~ /^(?:get|set|end)(pw|gr|host|net|proto|serv|sp)/) {
|
|---|
| 644 | $genfunc = "${1}ent";
|
|---|
| 645 | } elsif ($genfunc eq 'srand48') {
|
|---|
| 646 | $genfunc = "drand48";
|
|---|
| 647 | }
|
|---|
| 648 | my $b = $a;
|
|---|
| 649 | my $w = '';
|
|---|
| 650 | substr($b, 0, $seenu{$func}) = '';
|
|---|
| 651 | if ($func =~ /^random$/) {
|
|---|
| 652 | $true = "PL_reentrant_buffer->_random_retval";
|
|---|
| 653 | } elsif ($b =~ /R/) {
|
|---|
| 654 | $true = "PL_reentrant_buffer->_${genfunc}_ptr";
|
|---|
| 655 | } elsif ($b =~ /T/ && $func eq 'drand48') {
|
|---|
| 656 | $true = "PL_reentrant_buffer->_${genfunc}_double";
|
|---|
| 657 | } elsif ($b =~ /S/) {
|
|---|
| 658 | if ($func =~ /^readdir/) {
|
|---|
| 659 | $true = "PL_reentrant_buffer->_${genfunc}_struct";
|
|---|
| 660 | } else {
|
|---|
| 661 | $true = "&PL_reentrant_buffer->_${genfunc}_struct";
|
|---|
| 662 | }
|
|---|
| 663 | } elsif ($b =~ /B/) {
|
|---|
| 664 | $true = "PL_reentrant_buffer->_${genfunc}_buffer";
|
|---|
| 665 | }
|
|---|
| 666 | if (length $b) {
|
|---|
| 667 | $w = join ", ",
|
|---|
| 668 | map {
|
|---|
| 669 | $_ eq 'R' ?
|
|---|
| 670 | "&PL_reentrant_buffer->_${genfunc}_ptr" :
|
|---|
| 671 | $_ eq 'E' ?
|
|---|
| 672 | "&PL_reentrant_buffer->_${genfunc}_errno" :
|
|---|
| 673 | $_ eq 'B' ?
|
|---|
| 674 | "PL_reentrant_buffer->_${genfunc}_buffer" :
|
|---|
| 675 | $_ =~ /^[WI]$/ ?
|
|---|
| 676 | "PL_reentrant_buffer->_${genfunc}_size" :
|
|---|
| 677 | $_ eq 'H' ?
|
|---|
| 678 | "&PL_reentrant_buffer->_${genfunc}_fptr" :
|
|---|
| 679 | $_ eq 'D' ?
|
|---|
| 680 | "&PL_reentrant_buffer->_${genfunc}_data" :
|
|---|
| 681 | $_ eq 'S' ?
|
|---|
| 682 | ($func =~ /^readdir\d*$/ ?
|
|---|
| 683 | "PL_reentrant_buffer->_${genfunc}_struct" :
|
|---|
| 684 | $func =~ /^crypt$/ ?
|
|---|
| 685 | "PL_reentrant_buffer->_${genfunc}_struct_buffer" :
|
|---|
| 686 | "&PL_reentrant_buffer->_${genfunc}_struct") :
|
|---|
| 687 | $_ eq 'T' && $func eq 'drand48' ?
|
|---|
| 688 | "&PL_reentrant_buffer->_${genfunc}_double" :
|
|---|
| 689 | $_ =~ /^[ilt]$/ && $func eq 'random' ?
|
|---|
| 690 | "&PL_reentrant_buffer->_random_retval" :
|
|---|
| 691 | $_
|
|---|
| 692 | } split '', $b;
|
|---|
| 693 | $w = ", $w" if length $v;
|
|---|
| 694 | }
|
|---|
| 695 | my $call = "${func}_r($v$w)";
|
|---|
| 696 |
|
|---|
| 697 | # Must make OpenBSD happy
|
|---|
| 698 | my $memzero = '';
|
|---|
| 699 | if($p =~ /D$/ &&
|
|---|
| 700 | ($genfunc eq 'protoent' || $genfunc eq 'servent')) {
|
|---|
| 701 | $memzero = 'REENTR_MEMZERO(&PL_reentrant_buffer->_' . $genfunc . '_data, sizeof(PL_reentrant_buffer->_' . $genfunc . '_data))';
|
|---|
| 702 | }
|
|---|
| 703 | push @wrap, <<EOF;
|
|---|
| 704 | # if !defined($func) && ${FUNC}_R_PROTO == REENTRANT_PROTO_$p
|
|---|
| 705 | EOF
|
|---|
| 706 | if ($r eq 'V' || $r eq 'B') {
|
|---|
| 707 | push @wrap, <<EOF;
|
|---|
| 708 | # define $func($v) $call
|
|---|
| 709 | EOF
|
|---|
| 710 | } else {
|
|---|
| 711 | if ($func =~ /^get/) {
|
|---|
| 712 | my $rv = $v ? ", $v" : "";
|
|---|
| 713 | if ($r eq 'I') {
|
|---|
| 714 | $call = qq[((PL_REENTRANT_RETINT = $call)$test ? $true : (((PL_REENTRANT_RETINT == ERANGE) || (errno == ERANGE)) ? ($seenm{$func}{$seenr{$func}})Perl_reentrant_retry("$func"$rv) : 0))];
|
|---|
| 715 | my $arg = join(", ", map { $seenm{$func}{substr($a,$_,1)}." ".$v[$_] } 0..$seenu{$func}-1);
|
|---|
| 716 | my $ret = $seenr{$func} eq 'V' ? "" : "return ";
|
|---|
| 717 | my $memzero_ = $memzero ? "$memzero, " : "";
|
|---|
| 718 | push @wrap, <<EOF;
|
|---|
| 719 | # ifdef PERL_CORE
|
|---|
| 720 | # define $func($v) ($memzero_$call)
|
|---|
| 721 | # else
|
|---|
| 722 | # if defined(__GNUC__) && !defined(__STRICT_ANSI__) && !defined(PERL_GCC_PEDANTIC)
|
|---|
| 723 | # define $func($v) ({int PL_REENTRANT_RETINT; $memzero; $call;})
|
|---|
| 724 | # else
|
|---|
| 725 | # define $func($v) Perl_reentr_$func($v)
|
|---|
| 726 | static $seenm{$func}{$seenr{$func}} Perl_reentr_$func($arg) {
|
|---|
| 727 | dTHX;
|
|---|
| 728 | int PL_REENTRANT_RETINT;
|
|---|
| 729 | $memzero;
|
|---|
| 730 | $ret$call;
|
|---|
| 731 | }
|
|---|
| 732 | # endif
|
|---|
| 733 | # endif
|
|---|
| 734 | EOF
|
|---|
| 735 | } else {
|
|---|
| 736 | push @wrap, <<EOF;
|
|---|
| 737 | # define $func($v) ($call$test ? $true : ((errno == ERANGE) ? ($seent{$func} *) Perl_reentrant_retry("$func"$rv) : 0))
|
|---|
| 738 | EOF
|
|---|
| 739 | }
|
|---|
| 740 | } else {
|
|---|
| 741 | push @wrap, <<EOF;
|
|---|
| 742 | # define $func($v) ($call$test ? $true : 0)
|
|---|
| 743 | EOF
|
|---|
| 744 | }
|
|---|
| 745 | }
|
|---|
| 746 | push @wrap, <<EOF;
|
|---|
| 747 | # endif
|
|---|
| 748 | EOF
|
|---|
| 749 | }
|
|---|
| 750 |
|
|---|
| 751 | push @wrap, $endif, "\n";
|
|---|
| 752 | }
|
|---|
| 753 | }
|
|---|
| 754 |
|
|---|
| 755 | # New struct members added here to maintain binary compatibility with 5.8.0
|
|---|
| 756 |
|
|---|
| 757 | if (exists $seena{crypt}) {
|
|---|
| 758 | push @struct, <<EOF;
|
|---|
| 759 | #ifdef HAS_CRYPT_R
|
|---|
| 760 | #if CRYPT_R_PROTO == REENTRANT_PROTO_B_CCD
|
|---|
| 761 | #else
|
|---|
| 762 | struct crypt_data *_crypt_struct_buffer;
|
|---|
| 763 | #endif
|
|---|
| 764 | #endif /* HAS_CRYPT_R */
|
|---|
| 765 | EOF
|
|---|
| 766 | }
|
|---|
| 767 |
|
|---|
| 768 | if (exists $seena{random}) {
|
|---|
| 769 | push @struct, <<EOF;
|
|---|
| 770 | #ifdef HAS_RANDOM_R
|
|---|
| 771 | # if RANDOM_R_PROTO == REENTRANT_PROTO_I_iS
|
|---|
| 772 | int _random_retval;
|
|---|
| 773 | # endif
|
|---|
| 774 | # if RANDOM_R_PROTO == REENTRANT_PROTO_I_lS
|
|---|
| 775 | long _random_retval;
|
|---|
| 776 | # endif
|
|---|
| 777 | # if RANDOM_R_PROTO == REENTRANT_PROTO_I_St
|
|---|
| 778 | $seent{random} _random_struct;
|
|---|
| 779 | int32_t _random_retval;
|
|---|
| 780 | # endif
|
|---|
| 781 | #endif /* HAS_RANDOM_R */
|
|---|
| 782 | EOF
|
|---|
| 783 | }
|
|---|
| 784 |
|
|---|
| 785 | if (exists $seena{srandom}) {
|
|---|
| 786 | push @struct, <<EOF;
|
|---|
| 787 | #ifdef HAS_SRANDOM_R
|
|---|
| 788 | $seent{srandom} _srandom_struct;
|
|---|
| 789 | #endif /* HAS_SRANDOM_R */
|
|---|
| 790 | EOF
|
|---|
| 791 | }
|
|---|
| 792 |
|
|---|
| 793 |
|
|---|
| 794 | local $" = '';
|
|---|
| 795 |
|
|---|
| 796 | print <<EOF;
|
|---|
| 797 |
|
|---|
| 798 | /* Defines for indicating which special features are supported. */
|
|---|
| 799 |
|
|---|
| 800 | @define
|
|---|
| 801 | typedef struct {
|
|---|
| 802 | @struct
|
|---|
| 803 | int dummy; /* cannot have empty structs */
|
|---|
| 804 | } REENTR;
|
|---|
| 805 |
|
|---|
| 806 | #endif /* USE_REENTRANT_API */
|
|---|
| 807 |
|
|---|
| 808 | #endif
|
|---|
| 809 | EOF
|
|---|
| 810 |
|
|---|
| 811 | close(H);
|
|---|
| 812 |
|
|---|
| 813 | die "reentr.inc: $!" unless open(H, ">reentr.inc");
|
|---|
| 814 | select H;
|
|---|
| 815 |
|
|---|
| 816 | local $" = '';
|
|---|
| 817 |
|
|---|
| 818 | print <<EOF;
|
|---|
| 819 | /*
|
|---|
| 820 | * reentr.inc
|
|---|
| 821 | *
|
|---|
| 822 | * You may distribute under the terms of either the GNU General Public
|
|---|
| 823 | * License or the Artistic License, as specified in the README file.
|
|---|
| 824 | *
|
|---|
| 825 | * !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
|
|---|
| 826 | * This file is built by reentrl.pl from data in reentr.pl.
|
|---|
| 827 | */
|
|---|
| 828 |
|
|---|
| 829 | #ifndef REENTRINC
|
|---|
| 830 | #define REENTRINC
|
|---|
| 831 |
|
|---|
| 832 | #ifdef USE_REENTRANT_API
|
|---|
| 833 |
|
|---|
| 834 | /*
|
|---|
| 835 | * As of OpenBSD 3.7, reentrant functions are now working, they just are
|
|---|
| 836 | * incompatible with everyone else. To make OpenBSD happy, we have to
|
|---|
| 837 | * memzero out certain structures before calling the functions.
|
|---|
| 838 | */
|
|---|
| 839 | #if defined(__OpenBSD__)
|
|---|
| 840 | # define REENTR_MEMZERO(a,b) memzero(a,b)
|
|---|
| 841 | #else
|
|---|
| 842 | # define REENTR_MEMZERO(a,b) 0
|
|---|
| 843 | #endif
|
|---|
| 844 |
|
|---|
| 845 | /* The reentrant wrappers. */
|
|---|
| 846 |
|
|---|
| 847 | @wrap
|
|---|
| 848 |
|
|---|
| 849 | #endif /* USE_REENTRANT_API */
|
|---|
| 850 |
|
|---|
| 851 | #endif
|
|---|
| 852 |
|
|---|
| 853 | /* ex: set ro: */
|
|---|
| 854 | EOF
|
|---|
| 855 |
|
|---|
| 856 | close(H);
|
|---|
| 857 |
|
|---|
| 858 | # Prepare to write the reentr.c.
|
|---|
| 859 |
|
|---|
| 860 | safer_unlink 'reentr.c';
|
|---|
| 861 | die "reentr.c: $!" unless open(C, ">reentr.c");
|
|---|
| 862 | binmode C;
|
|---|
| 863 | select C;
|
|---|
| 864 | print <<EOF;
|
|---|
| 865 | /* -*- buffer-read-only: t -*-
|
|---|
| 866 | *
|
|---|
| 867 | * reentr.c
|
|---|
| 868 | *
|
|---|
| 869 | * Copyright (C) 2002, 2003, 2005, 2006 by Larry Wall and others
|
|---|
| 870 | *
|
|---|
| 871 | * You may distribute under the terms of either the GNU General Public
|
|---|
| 872 | * License or the Artistic License, as specified in the README file.
|
|---|
| 873 | *
|
|---|
| 874 | * !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
|
|---|
| 875 | * This file is built by reentr.pl from data in reentr.pl.
|
|---|
| 876 | *
|
|---|
| 877 | * "Saruman," I said, standing away from him, "only one hand at a time can
|
|---|
| 878 | * wield the One, and you know that well, so do not trouble to say we!"
|
|---|
| 879 | *
|
|---|
| 880 | * This file contains a collection of automatically created wrappers
|
|---|
| 881 | * (created by running reentr.pl) for reentrant (thread-safe) versions of
|
|---|
| 882 | * various library calls, such as getpwent_r. The wrapping is done so
|
|---|
| 883 | * that other files like pp_sys.c calling those library functions need not
|
|---|
| 884 | * care about the differences between various platforms' idiosyncrasies
|
|---|
| 885 | * regarding these reentrant interfaces.
|
|---|
| 886 | */
|
|---|
| 887 |
|
|---|
| 888 | #include "EXTERN.h"
|
|---|
| 889 | #define PERL_IN_REENTR_C
|
|---|
| 890 | #include "perl.h"
|
|---|
| 891 | #include "reentr.h"
|
|---|
| 892 |
|
|---|
| 893 | void
|
|---|
| 894 | Perl_reentrant_size(pTHX) {
|
|---|
| 895 | #ifdef USE_REENTRANT_API
|
|---|
| 896 | #define REENTRANTSMALLSIZE 256 /* Make something up. */
|
|---|
| 897 | #define REENTRANTUSUALSIZE 4096 /* Make something up. */
|
|---|
| 898 | @size
|
|---|
| 899 | #endif /* USE_REENTRANT_API */
|
|---|
| 900 | }
|
|---|
| 901 |
|
|---|
| 902 | void
|
|---|
| 903 | Perl_reentrant_init(pTHX) {
|
|---|
| 904 | #ifdef USE_REENTRANT_API
|
|---|
| 905 | Newx(PL_reentrant_buffer, 1, REENTR);
|
|---|
| 906 | Perl_reentrant_size(aTHX);
|
|---|
| 907 | @init
|
|---|
| 908 | #endif /* USE_REENTRANT_API */
|
|---|
| 909 | }
|
|---|
| 910 |
|
|---|
| 911 | void
|
|---|
| 912 | Perl_reentrant_free(pTHX) {
|
|---|
| 913 | #ifdef USE_REENTRANT_API
|
|---|
| 914 | @free
|
|---|
| 915 | Safefree(PL_reentrant_buffer);
|
|---|
| 916 | #endif /* USE_REENTRANT_API */
|
|---|
| 917 | }
|
|---|
| 918 |
|
|---|
| 919 | void*
|
|---|
| 920 | Perl_reentrant_retry(const char *f, ...)
|
|---|
| 921 | {
|
|---|
| 922 | dTHX;
|
|---|
| 923 | void *retptr = NULL;
|
|---|
| 924 | #ifdef USE_REENTRANT_API
|
|---|
| 925 | # if defined(USE_HOSTENT_BUFFER) || defined(USE_GRENT_BUFFER) || defined(USE_NETENT_BUFFER) || defined(USE_PWENT_BUFFER) || defined(USE_PROTOENT_BUFFER) || defined(USE_SERVENT_BUFFER)
|
|---|
| 926 | void *p0;
|
|---|
| 927 | # endif
|
|---|
| 928 | # if defined(USE_SERVENT_BUFFER)
|
|---|
| 929 | void *p1;
|
|---|
| 930 | # endif
|
|---|
| 931 | # if defined(USE_HOSTENT_BUFFER)
|
|---|
| 932 | size_t asize;
|
|---|
| 933 | # endif
|
|---|
| 934 | # if defined(USE_HOSTENT_BUFFER) || defined(USE_NETENT_BUFFER) || defined(USE_PROTOENT_BUFFER) || defined(USE_SERVENT_BUFFER)
|
|---|
| 935 | int anint;
|
|---|
| 936 | # endif
|
|---|
| 937 | va_list ap;
|
|---|
| 938 |
|
|---|
| 939 | va_start(ap, f);
|
|---|
| 940 |
|
|---|
| 941 | switch (PL_op->op_type) {
|
|---|
| 942 | #ifdef USE_HOSTENT_BUFFER
|
|---|
| 943 | case OP_GHBYADDR:
|
|---|
| 944 | case OP_GHBYNAME:
|
|---|
| 945 | case OP_GHOSTENT:
|
|---|
| 946 | {
|
|---|
| 947 | #ifdef PERL_REENTRANT_MAXSIZE
|
|---|
| 948 | if (PL_reentrant_buffer->_hostent_size <=
|
|---|
| 949 | PERL_REENTRANT_MAXSIZE / 2)
|
|---|
| 950 | #endif
|
|---|
| 951 | {
|
|---|
| 952 | PL_reentrant_buffer->_hostent_size *= 2;
|
|---|
| 953 | Renew(PL_reentrant_buffer->_hostent_buffer,
|
|---|
| 954 | PL_reentrant_buffer->_hostent_size, char);
|
|---|
| 955 | switch (PL_op->op_type) {
|
|---|
| 956 | case OP_GHBYADDR:
|
|---|
| 957 | p0 = va_arg(ap, void *);
|
|---|
| 958 | asize = va_arg(ap, size_t);
|
|---|
| 959 | anint = va_arg(ap, int);
|
|---|
| 960 | retptr = gethostbyaddr(p0, asize, anint); break;
|
|---|
| 961 | case OP_GHBYNAME:
|
|---|
| 962 | p0 = va_arg(ap, void *);
|
|---|
| 963 | retptr = gethostbyname((char *)p0); break;
|
|---|
| 964 | case OP_GHOSTENT:
|
|---|
| 965 | retptr = gethostent(); break;
|
|---|
| 966 | default:
|
|---|
| 967 | SETERRNO(ERANGE, LIB_INVARG);
|
|---|
| 968 | break;
|
|---|
| 969 | }
|
|---|
| 970 | }
|
|---|
| 971 | }
|
|---|
| 972 | break;
|
|---|
| 973 | #endif
|
|---|
| 974 | #ifdef USE_GRENT_BUFFER
|
|---|
| 975 | case OP_GGRNAM:
|
|---|
| 976 | case OP_GGRGID:
|
|---|
| 977 | case OP_GGRENT:
|
|---|
| 978 | {
|
|---|
| 979 | #ifdef PERL_REENTRANT_MAXSIZE
|
|---|
| 980 | if (PL_reentrant_buffer->_grent_size <=
|
|---|
| 981 | PERL_REENTRANT_MAXSIZE / 2)
|
|---|
| 982 | #endif
|
|---|
| 983 | {
|
|---|
| 984 | Gid_t gid;
|
|---|
| 985 | PL_reentrant_buffer->_grent_size *= 2;
|
|---|
| 986 | Renew(PL_reentrant_buffer->_grent_buffer,
|
|---|
| 987 | PL_reentrant_buffer->_grent_size, char);
|
|---|
| 988 | switch (PL_op->op_type) {
|
|---|
| 989 | case OP_GGRNAM:
|
|---|
| 990 | p0 = va_arg(ap, void *);
|
|---|
| 991 | retptr = getgrnam((char *)p0); break;
|
|---|
| 992 | case OP_GGRGID:
|
|---|
| 993 | #if Gid_t_size < INTSIZE
|
|---|
| 994 | gid = (Gid_t)va_arg(ap, int);
|
|---|
| 995 | #else
|
|---|
| 996 | gid = va_arg(ap, Gid_t);
|
|---|
| 997 | #endif
|
|---|
| 998 | retptr = getgrgid(gid); break;
|
|---|
| 999 | case OP_GGRENT:
|
|---|
| 1000 | retptr = getgrent(); break;
|
|---|
| 1001 | default:
|
|---|
| 1002 | SETERRNO(ERANGE, LIB_INVARG);
|
|---|
| 1003 | break;
|
|---|
| 1004 | }
|
|---|
| 1005 | }
|
|---|
| 1006 | }
|
|---|
| 1007 | break;
|
|---|
| 1008 | #endif
|
|---|
| 1009 | #ifdef USE_NETENT_BUFFER
|
|---|
| 1010 | case OP_GNBYADDR:
|
|---|
| 1011 | case OP_GNBYNAME:
|
|---|
| 1012 | case OP_GNETENT:
|
|---|
| 1013 | {
|
|---|
| 1014 | #ifdef PERL_REENTRANT_MAXSIZE
|
|---|
| 1015 | if (PL_reentrant_buffer->_netent_size <=
|
|---|
| 1016 | PERL_REENTRANT_MAXSIZE / 2)
|
|---|
| 1017 | #endif
|
|---|
| 1018 | {
|
|---|
| 1019 | Netdb_net_t net;
|
|---|
| 1020 | PL_reentrant_buffer->_netent_size *= 2;
|
|---|
| 1021 | Renew(PL_reentrant_buffer->_netent_buffer,
|
|---|
| 1022 | PL_reentrant_buffer->_netent_size, char);
|
|---|
| 1023 | switch (PL_op->op_type) {
|
|---|
| 1024 | case OP_GNBYADDR:
|
|---|
| 1025 | net = va_arg(ap, Netdb_net_t);
|
|---|
| 1026 | anint = va_arg(ap, int);
|
|---|
| 1027 | retptr = getnetbyaddr(net, anint); break;
|
|---|
| 1028 | case OP_GNBYNAME:
|
|---|
| 1029 | p0 = va_arg(ap, void *);
|
|---|
| 1030 | retptr = getnetbyname((char *)p0); break;
|
|---|
| 1031 | case OP_GNETENT:
|
|---|
| 1032 | retptr = getnetent(); break;
|
|---|
| 1033 | default:
|
|---|
| 1034 | SETERRNO(ERANGE, LIB_INVARG);
|
|---|
| 1035 | break;
|
|---|
| 1036 | }
|
|---|
| 1037 | }
|
|---|
| 1038 | }
|
|---|
| 1039 | break;
|
|---|
| 1040 | #endif
|
|---|
| 1041 | #ifdef USE_PWENT_BUFFER
|
|---|
| 1042 | case OP_GPWNAM:
|
|---|
| 1043 | case OP_GPWUID:
|
|---|
| 1044 | case OP_GPWENT:
|
|---|
| 1045 | {
|
|---|
| 1046 | #ifdef PERL_REENTRANT_MAXSIZE
|
|---|
| 1047 | if (PL_reentrant_buffer->_pwent_size <=
|
|---|
| 1048 | PERL_REENTRANT_MAXSIZE / 2)
|
|---|
| 1049 | #endif
|
|---|
| 1050 | {
|
|---|
| 1051 | Uid_t uid;
|
|---|
| 1052 | PL_reentrant_buffer->_pwent_size *= 2;
|
|---|
| 1053 | Renew(PL_reentrant_buffer->_pwent_buffer,
|
|---|
| 1054 | PL_reentrant_buffer->_pwent_size, char);
|
|---|
| 1055 | switch (PL_op->op_type) {
|
|---|
| 1056 | case OP_GPWNAM:
|
|---|
| 1057 | p0 = va_arg(ap, void *);
|
|---|
| 1058 | retptr = getpwnam((char *)p0); break;
|
|---|
| 1059 | case OP_GPWUID:
|
|---|
| 1060 | #if Uid_t_size < INTSIZE
|
|---|
| 1061 | uid = (Uid_t)va_arg(ap, int);
|
|---|
| 1062 | #else
|
|---|
| 1063 | uid = va_arg(ap, Uid_t);
|
|---|
| 1064 | #endif
|
|---|
| 1065 | retptr = getpwuid(uid); break;
|
|---|
| 1066 | case OP_GPWENT:
|
|---|
| 1067 | retptr = getpwent(); break;
|
|---|
| 1068 | default:
|
|---|
| 1069 | SETERRNO(ERANGE, LIB_INVARG);
|
|---|
| 1070 | break;
|
|---|
| 1071 | }
|
|---|
| 1072 | }
|
|---|
| 1073 | }
|
|---|
| 1074 | break;
|
|---|
| 1075 | #endif
|
|---|
| 1076 | #ifdef USE_PROTOENT_BUFFER
|
|---|
| 1077 | case OP_GPBYNAME:
|
|---|
| 1078 | case OP_GPBYNUMBER:
|
|---|
| 1079 | case OP_GPROTOENT:
|
|---|
| 1080 | {
|
|---|
| 1081 | #ifdef PERL_REENTRANT_MAXSIZE
|
|---|
| 1082 | if (PL_reentrant_buffer->_protoent_size <=
|
|---|
| 1083 | PERL_REENTRANT_MAXSIZE / 2)
|
|---|
| 1084 | #endif
|
|---|
| 1085 | {
|
|---|
| 1086 | PL_reentrant_buffer->_protoent_size *= 2;
|
|---|
| 1087 | Renew(PL_reentrant_buffer->_protoent_buffer,
|
|---|
| 1088 | PL_reentrant_buffer->_protoent_size, char);
|
|---|
| 1089 | switch (PL_op->op_type) {
|
|---|
| 1090 | case OP_GPBYNAME:
|
|---|
| 1091 | p0 = va_arg(ap, void *);
|
|---|
| 1092 | retptr = getprotobyname((char *)p0); break;
|
|---|
| 1093 | case OP_GPBYNUMBER:
|
|---|
| 1094 | anint = va_arg(ap, int);
|
|---|
| 1095 | retptr = getprotobynumber(anint); break;
|
|---|
| 1096 | case OP_GPROTOENT:
|
|---|
| 1097 | retptr = getprotoent(); break;
|
|---|
| 1098 | default:
|
|---|
| 1099 | SETERRNO(ERANGE, LIB_INVARG);
|
|---|
| 1100 | break;
|
|---|
| 1101 | }
|
|---|
| 1102 | }
|
|---|
| 1103 | }
|
|---|
| 1104 | break;
|
|---|
| 1105 | #endif
|
|---|
| 1106 | #ifdef USE_SERVENT_BUFFER
|
|---|
| 1107 | case OP_GSBYNAME:
|
|---|
| 1108 | case OP_GSBYPORT:
|
|---|
| 1109 | case OP_GSERVENT:
|
|---|
| 1110 | {
|
|---|
| 1111 | #ifdef PERL_REENTRANT_MAXSIZE
|
|---|
| 1112 | if (PL_reentrant_buffer->_servent_size <=
|
|---|
| 1113 | PERL_REENTRANT_MAXSIZE / 2)
|
|---|
| 1114 | #endif
|
|---|
| 1115 | {
|
|---|
| 1116 | PL_reentrant_buffer->_servent_size *= 2;
|
|---|
| 1117 | Renew(PL_reentrant_buffer->_servent_buffer,
|
|---|
| 1118 | PL_reentrant_buffer->_servent_size, char);
|
|---|
| 1119 | switch (PL_op->op_type) {
|
|---|
| 1120 | case OP_GSBYNAME:
|
|---|
| 1121 | p0 = va_arg(ap, void *);
|
|---|
| 1122 | p1 = va_arg(ap, void *);
|
|---|
| 1123 | retptr = getservbyname((char *)p0, (char *)p1); break;
|
|---|
| 1124 | case OP_GSBYPORT:
|
|---|
| 1125 | anint = va_arg(ap, int);
|
|---|
| 1126 | p0 = va_arg(ap, void *);
|
|---|
| 1127 | retptr = getservbyport(anint, (char *)p0); break;
|
|---|
| 1128 | case OP_GSERVENT:
|
|---|
| 1129 | retptr = getservent(); break;
|
|---|
| 1130 | default:
|
|---|
| 1131 | SETERRNO(ERANGE, LIB_INVARG);
|
|---|
| 1132 | break;
|
|---|
| 1133 | }
|
|---|
| 1134 | }
|
|---|
| 1135 | }
|
|---|
| 1136 | break;
|
|---|
| 1137 | #endif
|
|---|
| 1138 | default:
|
|---|
| 1139 | /* Not known how to retry, so just fail. */
|
|---|
| 1140 | break;
|
|---|
| 1141 | }
|
|---|
| 1142 |
|
|---|
| 1143 | va_end(ap);
|
|---|
| 1144 | #endif
|
|---|
| 1145 | return retptr;
|
|---|
| 1146 | }
|
|---|
| 1147 |
|
|---|
| 1148 | /* ex: set ro: */
|
|---|
| 1149 | EOF
|
|---|
| 1150 |
|
|---|
| 1151 | __DATA__
|
|---|
| 1152 | asctime B_S |time |const struct tm|B_SB|B_SBI|I_SB|I_SBI
|
|---|
| 1153 | crypt B_CC |crypt |struct crypt_data|B_CCS|B_CCD|D=CRYPTD*
|
|---|
| 1154 | ctermid B_B |stdio | |B_B
|
|---|
| 1155 | ctime B_S |time |const time_t |B_SB|B_SBI|I_SB|I_SBI
|
|---|
| 1156 | drand48 d_V |stdlib |struct drand48_data |I_ST|T=double*|d=double
|
|---|
| 1157 | endgrent |grp | |I_H|V_H
|
|---|
| 1158 | endhostent |netdb | |I_D|V_D|D=struct hostent_data*
|
|---|
| 1159 | endnetent |netdb | |I_D|V_D|D=struct netent_data*
|
|---|
| 1160 | endprotoent |netdb | |I_D|V_D|D=struct protoent_data*
|
|---|
| 1161 | endpwent |pwd | |I_H|V_H
|
|---|
| 1162 | endservent |netdb | |I_D|V_D|D=struct servent_data*
|
|---|
| 1163 | getgrent S_V |grp |struct group |I_SBWR|I_SBIR|S_SBW|S_SBI|I_SBI|I_SBIH
|
|---|
| 1164 | getgrgid S_T |grp |struct group |I_TSBWR|I_TSBIR|I_TSBI|S_TSBI|T=gid_t
|
|---|
| 1165 | getgrnam S_C |grp |struct group |I_CSBWR|I_CSBIR|S_CBI|I_CSBI|S_CSBI
|
|---|
| 1166 | gethostbyaddr S_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
|
|---|
| 1167 | gethostbyname S_C |netdb |struct hostent |I_CSBWRE|S_CSBIE|I_CSD|D=struct hostent_data*
|
|---|
| 1168 | gethostent S_V |netdb |struct hostent |I_SBWRE|I_SBIE|S_SBIE|S_SBI|I_SBI|I_SD|D=struct hostent_data*
|
|---|
| 1169 | getlogin B_V |unistd |char |I_BW|I_BI|B_BW|B_BI
|
|---|
| 1170 | getnetbyaddr S_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
|
|---|
| 1171 | getnetbyname S_C |netdb |struct netent |I_CSBWRE|I_CSBI|S_CSBI|I_CSD|D=struct netent_data*
|
|---|
| 1172 | getnetent S_V |netdb |struct netent |I_SBWRE|I_SBIE|S_SBIE|S_SBI|I_SBI|I_SD|D=struct netent_data*
|
|---|
| 1173 | getprotobyname S_C |netdb |struct protoent|I_CSBWR|S_CSBI|I_CSD|D=struct protoent_data*
|
|---|
| 1174 | getprotobynumber S_I |netdb |struct protoent|I_ISBWR|S_ISBI|I_ISD|D=struct protoent_data*
|
|---|
| 1175 | getprotoent S_V |netdb |struct protoent|I_SBWR|I_SBI|S_SBI|I_SD|D=struct protoent_data*
|
|---|
| 1176 | getpwent S_V |pwd |struct passwd |I_SBWR|I_SBIR|S_SBW|S_SBI|I_SBI|I_SBIH
|
|---|
| 1177 | getpwnam S_C |pwd |struct passwd |I_CSBWR|I_CSBIR|S_CSBI|I_CSBI
|
|---|
| 1178 | getpwuid S_T |pwd |struct passwd |I_TSBWR|I_TSBIR|I_TSBI|S_TSBI|T=uid_t
|
|---|
| 1179 | getservbyname S_CC |netdb |struct servent |I_CCSBWR|S_CCSBI|I_CCSD|D=struct servent_data*
|
|---|
| 1180 | getservbyport S_IC |netdb |struct servent |I_ICSBWR|S_ICSBI|I_ICSD|D=struct servent_data*
|
|---|
| 1181 | getservent S_V |netdb |struct servent |I_SBWR|I_SBI|S_SBI|I_SD|D=struct servent_data*
|
|---|
| 1182 | getspnam S_C |shadow |struct spwd |I_CSBWR|S_CSBI
|
|---|
| 1183 | gmtime S_T |time |struct tm |S_TS|I_TS|T=const time_t*
|
|---|
| 1184 | localtime S_T |time |struct tm |S_TS|I_TS|T=const time_t*
|
|---|
| 1185 | random L_V |stdlib |struct random_data|I_iS|I_lS|I_St|i=int*|l=long*|t=int32_t*
|
|---|
| 1186 | readdir S_T |dirent |struct dirent |I_TSR|I_TS|T=DIR*
|
|---|
| 1187 | readdir64 S_T |dirent |struct dirent64|I_TSR|I_TS|T=DIR*
|
|---|
| 1188 | setgrent |grp | |I_H|V_H
|
|---|
| 1189 | sethostent V_I |netdb | |I_ID|V_ID|D=struct hostent_data*
|
|---|
| 1190 | setlocale B_IC |locale | |I_ICBI
|
|---|
| 1191 | setnetent V_I |netdb | |I_ID|V_ID|D=struct netent_data*
|
|---|
| 1192 | setprotoent V_I |netdb | |I_ID|V_ID|D=struct protoent_data*
|
|---|
| 1193 | setpwent |pwd | |I_H|V_H
|
|---|
| 1194 | setservent V_I |netdb | |I_ID|V_ID|D=struct servent_data*
|
|---|
| 1195 | srand48 V_L |stdlib |struct drand48_data |I_LS
|
|---|
| 1196 | srandom V_T |stdlib |struct random_data|I_TS|T=unsigned int
|
|---|
| 1197 | strerror B_I |string | |I_IBW|I_IBI|B_IBW
|
|---|
| 1198 | tmpnam B_B |stdio | |B_B
|
|---|
| 1199 | ttyname B_I |unistd | |I_IBW|I_IBI|B_IBI
|
|---|
