Front page | perl.perl5.porters |
Postings from February 2000
[PATCH 5.5.640] add gethostname() (was Re: fixing Sys::Hostname)
Thread Next
From:
Greg Bacon
Date:
February 7, 2000 13:56
Subject:
[PATCH 5.5.640] add gethostname() (was Re: fixing Sys::Hostname)
Message ID:
200002072203.QAA20598@ruby.itsc.uah.edu
In message <6923.949758404@chthon>,
Tom Christiansen writes:
: The latest changes to Sys::Hostname's (no, that's not the ::s module
: :-) hostname() function need to be addressed. Why? Because they
: by default needlessly pull in a ziggabyte of POSIX material just
: to get at uname(). The performance hit is dramatic and permanent.
How's this? In addition to adding a gethostname() operator, it updates
Sys::Hostname to make use of the new operator. It needs PERL_OBJECT
support and a perldelta patch if Sarathy likes it. With the exception
of the known DB_File issue, this perl builds and passes all tests.
Don't forget to make regen_headers.
diff -ruN perl5.5.640.dist/embed.h perl5.5.640/embed.h
--- perl5.5.640.dist/embed.h Wed Feb 2 00:53:46 2000
+++ perl5.5.640/embed.h Mon Feb 7 15:09:26 2000
@@ -1251,6 +1251,7 @@
#define pp_ggrnam Perl_pp_ggrnam
#define pp_ghbyaddr Perl_pp_ghbyaddr
#define pp_ghbyname Perl_pp_ghbyname
+#define pp_ghname Perl_pp_ghname
#define pp_ghostent Perl_pp_ghostent
#define pp_glob Perl_pp_glob
#define pp_gmtime Perl_pp_gmtime
@@ -2663,6 +2664,7 @@
#define pp_ggrnam() Perl_pp_ggrnam(aTHX)
#define pp_ghbyaddr() Perl_pp_ghbyaddr(aTHX)
#define pp_ghbyname() Perl_pp_ghbyname(aTHX)
+#define pp_ghname() Perl_pp_ghname(aTHX)
#define pp_ghostent() Perl_pp_ghostent(aTHX)
#define pp_glob() Perl_pp_glob(aTHX)
#define pp_gmtime() Perl_pp_gmtime(aTHX)
@@ -5179,6 +5181,8 @@
#define pp_ghbyaddr Perl_pp_ghbyaddr
#define Perl_pp_ghbyname CPerlObj::Perl_pp_ghbyname
#define pp_ghbyname Perl_pp_ghbyname
+#define Perl_pp_ghname CPerlObj::Perl_pp_ghname
+#define pp_ghname Perl_pp_ghname
#define Perl_pp_ghostent CPerlObj::Perl_pp_ghostent
#define pp_ghostent Perl_pp_ghostent
#define Perl_pp_glob CPerlObj::Perl_pp_glob
diff -ruN perl5.5.640.dist/ext/Opcode/Opcode.pm perl5.5.640/ext/Opcode/Opcode.pm
--- perl5.5.640.dist/ext/Opcode/Opcode.pm Sun Jan 23 04:34:30 2000
+++ perl5.5.640/ext/Opcode/Opcode.pm Mon Feb 7 15:08:15 2000
@@ -458,13 +458,13 @@
=item :sys_db
- ghbyname ghbyaddr ghostent shostent ehostent -- hosts
- gnbyname gnbyaddr gnetent snetent enetent -- networks
- gpbyname gpbynumber gprotoent sprotoent eprotoent -- protocols
- gsbyname gsbyport gservent sservent eservent -- services
+ ghbyname ghbyaddr ghostent shostent ehostent ghname -- hosts
+ gnbyname gnbyaddr gnetent snetent enetent -- networks
+ gpbyname gpbynumber gprotoent sprotoent eprotoent -- protocols
+ gsbyname gsbyport gservent sservent eservent -- services
- gpwnam gpwuid gpwent spwent epwent getlogin -- users
- ggrnam ggrgid ggrent sgrent egrent -- groups
+ gpwnam gpwuid gpwent spwent epwent getlogin -- users
+ ggrnam ggrgid ggrent sgrent egrent -- groups
=item :browse
diff -ruN perl5.5.640.dist/iperlsys.h perl5.5.640/iperlsys.h
--- perl5.5.640.dist/iperlsys.h Thu Jan 27 16:53:27 2000
+++ perl5.5.640/iperlsys.h Mon Feb 7 14:50:44 2000
@@ -1099,6 +1099,8 @@
(*PL_Proc->pGetgid)(PL_Proc)
#define PerlProc_getegid() \
(*PL_Proc->pGetegid)(PL_Proc)
+#define PerlProc_gethostname() \
+ (*PL_Proc->pGethostname)(PL_Proc)
#define PerlProc_getlogin() \
(*PL_Proc->pGetlogin)(PL_Proc)
#define PerlProc_kill(i, a) \
@@ -1163,6 +1165,8 @@
#define PerlProc_geteuid() geteuid()
#define PerlProc_getgid() getgid()
#define PerlProc_getegid() getegid()
+#define PerlProc_gethostname(s, n) \
+ gethostname((s), (n))
#define PerlProc_getlogin() getlogin()
#define PerlProc_kill(i, a) kill((i), (a))
#define PerlProc_killpg(i, a) killpg((i), (a))
@@ -1345,8 +1349,6 @@
(*PL_Sock->pGethostbyname)(PL_Sock, n)
#define PerlSock_gethostent() \
(*PL_Sock->pGethostent)(PL_Sock)
-#define PerlSock_gethostname(n, l) \
- (*PL_Sock->pGethostname)(PL_Sock, n, l)
#define PerlSock_getnetbyaddr(n, t) \
(*PL_Sock->pGetnetbyaddr)(PL_Sock, n, t)
#define PerlSock_getnetbyname(c) \
diff -ruN perl5.5.640.dist/keywords.pl perl5.5.640/keywords.pl
--- perl5.5.640.dist/keywords.pl Wed Jan 26 12:56:46 2000
+++ perl5.5.640/keywords.pl Mon Feb 7 12:52:05 2000
@@ -105,6 +105,7 @@
gethostbyaddr
gethostbyname
gethostent
+gethostname
getlogin
getnetbyaddr
getnetbyname
diff -ruN perl5.5.640.dist/lib/Sys/Hostname.pm perl5.5.640/lib/Sys/Hostname.pm
--- perl5.5.640.dist/lib/Sys/Hostname.pm Sun Jan 23 02:46:22 2000
+++ perl5.5.640/lib/Sys/Hostname.pm Mon Feb 7 15:53:28 2000
@@ -17,7 +17,7 @@
=head1 DESCRIPTION
Attempts several methods of getting the system hostname and
-then caches the result. It tries C<syscall(SYS_gethostname)>,
+then caches the result. It tries gethostname(),
C<`hostname`>, C<`uname -n`>, and the file F</com/host>.
If all that fails it C<croak>s.
@@ -34,6 +34,10 @@
sub hostname {
# method 1 - we already know it
+ return $host if defined $host;
+
+ # method 1a - ask the system
+ eval { local $SIG{__DIE__}; $host = gethostname };
return $host if defined $host;
if ($^O eq 'VMS') {
diff -ruN perl5.5.640.dist/op.c perl5.5.640/op.c
--- perl5.5.640.dist/op.c Tue Feb 1 14:29:47 2000
+++ perl5.5.640/op.c Mon Feb 7 15:31:43 2000
@@ -1114,6 +1114,7 @@
case OP_GGRNAM:
case OP_GGRGID:
case OP_GETLOGIN:
+ case OP_GHNAME:
func_ops:
if (!(o->op_private & (OPpLVAL_INTRO|OPpOUR_INTRO)))
useless = PL_op_desc[o->op_type];
diff -ruN perl5.5.640.dist/opcode.h perl5.5.640/opcode.h
--- perl5.5.640.dist/opcode.h Thu Jan 27 16:53:27 2000
+++ perl5.5.640/opcode.h Mon Feb 7 15:09:25 2000
@@ -361,6 +361,7 @@
"sgrent",
"egrent",
"getlogin",
+ "ghname",
"syscall",
"lock",
"threadsv",
@@ -719,6 +720,7 @@
"setgrent",
"endgrent",
"getlogin",
+ "gethostname",
"syscall",
"lock",
"per-thread value",
@@ -1082,6 +1084,7 @@
MEMBER_TO_FPTR(Perl_pp_sgrent),
MEMBER_TO_FPTR(Perl_pp_egrent),
MEMBER_TO_FPTR(Perl_pp_getlogin),
+ MEMBER_TO_FPTR(Perl_pp_ghname),
MEMBER_TO_FPTR(Perl_pp_syscall),
MEMBER_TO_FPTR(Perl_pp_lock),
MEMBER_TO_FPTR(Perl_pp_threadsv),
@@ -1440,6 +1443,7 @@
MEMBER_TO_FPTR(Perl_ck_null), /* sgrent */
MEMBER_TO_FPTR(Perl_ck_null), /* egrent */
MEMBER_TO_FPTR(Perl_ck_null), /* getlogin */
+ MEMBER_TO_FPTR(Perl_ck_null), /* ghname */
MEMBER_TO_FPTR(Perl_ck_fun), /* syscall */
MEMBER_TO_FPTR(Perl_ck_rfun), /* lock */
MEMBER_TO_FPTR(Perl_ck_null), /* threadsv */
@@ -1798,6 +1802,7 @@
0x00000014, /* sgrent */
0x00000014, /* egrent */
0x0000000c, /* getlogin */
+ 0x0000000c, /* ghname */
0x0004281d, /* syscall */
0x00003604, /* lock */
0x00000044, /* threadsv */
diff -ruN perl5.5.640.dist/opcode.pl perl5.5.640/opcode.pl
--- perl5.5.640.dist/opcode.pl Wed Jan 12 15:03:56 2000
+++ perl5.5.640/opcode.pl Mon Feb 7 15:07:26 2000
@@ -327,7 +327,8 @@
# backtick glob warn die not OK (not always setting)
# warn not OK (RETPUSHYES)
# open fileno getc sysread syswrite ioctl accept shutdown
-# ftsize(etc) readlink telldir fork alarm getlogin not OK (RETPUSHUNDEF)
+# ftsize(etc) readlink telldir fork alarm getlogin
+# gethostname not OK (RETPUSHUNDEF)
# umask select not OK (XPUSHs(&PL_sv_undef);)
# fileno getc sysread syswrite tell not OK (meth("FILENO" "GETC"))
# sselect shm* sem* msg* syscall - unknown whether they are safe
@@ -811,6 +812,7 @@
sgrent setgrent ck_null is0
egrent endgrent ck_null is0
getlogin getlogin ck_null st0
+ghname gethostname ck_null st0
# Miscellaneous.
diff -ruN perl5.5.640.dist/opnames.h perl5.5.640/opnames.h
--- perl5.5.640.dist/opnames.h Thu Jan 27 16:53:27 2000
+++ perl5.5.640/opnames.h Mon Feb 7 15:09:25 2000
@@ -350,13 +350,14 @@
OP_SGRENT, /* 343 */
OP_EGRENT, /* 344 */
OP_GETLOGIN, /* 345 */
- OP_SYSCALL, /* 346 */
- OP_LOCK, /* 347 */
- OP_THREADSV, /* 348 */
- OP_SETSTATE, /* 349 */
- OP_METHOD_NAMED,/* 350 */
+ OP_GHNAME, /* 346 */
+ OP_SYSCALL, /* 347 */
+ OP_LOCK, /* 348 */
+ OP_THREADSV, /* 349 */
+ OP_SETSTATE, /* 350 */
+ OP_METHOD_NAMED,/* 351 */
OP_max
} opcode;
-#define MAXO 351
+#define MAXO 352
diff -ruN perl5.5.640.dist/pod/perlfunc.pod perl5.5.640/pod/perlfunc.pod
--- perl5.5.640.dist/pod/perlfunc.pod Wed Feb 2 02:14:32 2000
+++ perl5.5.640/pod/perlfunc.pod Mon Feb 7 15:30:27 2000
@@ -188,7 +188,7 @@
=item Fetching network info
C<endprotoent>, C<endservent>, C<gethostbyaddr>, C<gethostbyname>,
-C<gethostent>, C<getnetbyaddr>, C<getnetbyname>, C<getnetent>,
+C<gethostent>, C<gethostname>, C<getnetbyaddr>, C<getnetbyname>, C<getnetent>,
C<getprotobyname>, C<getprotobynumber>, C<getprotoent>,
C<getservbyname>, C<getservbyport>, C<getservent>, C<sethostent>,
C<setnetent>, C<setprotoent>, C<setservent>
@@ -225,7 +225,7 @@
C<dbmclose>, C<dbmopen>, C<dump>, C<endgrent>, C<endhostent>,
C<endnetent>, C<endprotoent>, C<endpwent>, C<endservent>, C<exec>,
C<fcntl>, C<flock>, C<fork>, C<getgrent>, C<getgrgid>, C<gethostent>,
-C<getlogin>, C<getnetbyaddr>, C<getnetbyname>, C<getnetent>,
+C<gethostname>, C<getlogin>, C<getnetbyaddr>, C<getnetbyname>, C<getnetent>,
C<getppid>, C<getprgp>, C<getpriority>, C<getprotobynumber>,
C<getprotoent>, C<getpwent>, C<getpwnam>, C<getpwuid>,
C<getservbyport>, C<getservent>, C<getsockopt>, C<glob>, C<ioctl>,
@@ -1705,6 +1705,14 @@
systems purporting POSIX compliance. See also the C<Term::ReadKey>
module from your nearest CPAN site; details on CPAN can be found on
L<perlmodlib/CPAN>.
+
+=item gethostname
+
+Implements the C library function of the same name. If C<gethostname>
+is not available on your system, use C<Sys::Hostname> (see
+L<Sys::Hostname>).
+
+ $hostname = gethostname || `hostname` || "beatsme";
=item getlogin
diff -ruN perl5.5.640.dist/pp.sym perl5.5.640/pp.sym
--- perl5.5.640.dist/pp.sym Sun Jan 2 15:12:55 2000
+++ perl5.5.640/pp.sym Mon Feb 7 15:09:25 2000
@@ -382,6 +382,7 @@
Perl_pp_sgrent
Perl_pp_egrent
Perl_pp_getlogin
+Perl_pp_ghname
Perl_pp_syscall
Perl_pp_lock
Perl_pp_threadsv
diff -ruN perl5.5.640.dist/pp_proto.h perl5.5.640/pp_proto.h
--- perl5.5.640.dist/pp_proto.h Thu Jan 27 16:53:27 2000
+++ perl5.5.640/pp_proto.h Mon Feb 7 15:09:25 2000
@@ -383,6 +383,7 @@
PERL_PPDEF(Perl_pp_sgrent)
PERL_PPDEF(Perl_pp_egrent)
PERL_PPDEF(Perl_pp_getlogin)
+PERL_PPDEF(Perl_pp_ghname)
PERL_PPDEF(Perl_pp_syscall)
PERL_PPDEF(Perl_pp_lock)
PERL_PPDEF(Perl_pp_threadsv)
diff -ruN perl5.5.640.dist/pp_sys.c perl5.5.640/pp_sys.c
--- perl5.5.640.dist/pp_sys.c Wed Feb 2 05:17:45 2000
+++ perl5.5.640/pp_sys.c Mon Feb 7 15:42:36 2000
@@ -5180,3 +5180,32 @@
}
#endif /* LOCKF_EMULATE_FLOCK */
+
+PP(pp_ghname)
+{
+ djSP; dTARGET;
+ IV retval;
+ SV *sv;
+#ifdef HAS_GETHOSTNAME
+
+#ifndef MAXHOSTNAMELEN
+# define MAXHOSTNAMELEN 256
+#endif
+
+ char tmps[MAXHOSTNAMELEN];
+
+ EXTEND(SP, 1);
+ retval = PerlProc_gethostname(tmps, sizeof(tmps));
+ if (retval == -1)
+ RETPUSHUNDEF;
+ else {
+ sv = newSVpvn(tmps, strlen(tmps));
+ PUSHs(sv);
+ SvTAINTED_on(sv);
+ }
+
+ RETURN;
+#else
+ DIE(aTHX_ PL_no_func, "gethostname");
+#endif
+}
diff -ruN perl5.5.640.dist/t/op/lex_assign.t perl5.5.640/t/op/lex_assign.t
--- perl5.5.640.dist/t/op/lex_assign.t Sun Jan 2 14:44:26 2000
+++ perl5.5.640/t/op/lex_assign.t Mon Feb 7 14:55:44 2000
@@ -310,3 +310,4 @@
'???' # semop
'???' # getlogin
'???' # syscall
+'???' # gethostname
diff -ruN perl5.5.640.dist/t/op/taint.t perl5.5.640/t/op/taint.t
--- perl5.5.640.dist/t/op/taint.t Tue Oct 12 10:34:57 1999
+++ perl5.5.640/t/op/taint.t Mon Feb 7 15:38:22 2000
@@ -605,3 +605,14 @@
$why =~ s/e/'-'.$$/ge;
test 149, tainted $why;
}
+
+# test that result of gethostname is tainted
+{
+ if ($Config{d_gethname}) {
+ my $hostname = gethostname;
+ test 150, tainted $hostname;
+ }
+ else {
+ for (150) { print "ok $_ # Skipped: gethostname() is not available\n" }
+ }
+}
diff -ruN perl5.5.640.dist/t/pragma/warn/op perl5.5.640/t/pragma/warn/op
--- perl5.5.640.dist/t/pragma/warn/op Sun Oct 24 06:51:32 1999
+++ perl5.5.640/t/pragma/warn/op Mon Feb 7 14:59:18 2000
@@ -458,6 +458,24 @@
########
# op.c
use warnings 'void' ;
+use Config ;
+BEGIN {
+ if ( ! $Config{d_gethname}) {
+ print <<EOM ;
+SKIPPED
+# gethostname not present
+EOM
+ exit
+ }
+}
+gethostname ; # OP_GETHNAME
+no warnings 'void' ;
+gethname ; # OP_GETHNAME
+EXPECT
+Useless use of gethostname in void context at - line 13.
+########
+# op.c
+use warnings 'void' ;
use Config ; BEGIN {
if ( ! $Config{d_socket}) {
print <<EOM ;
diff -ruN perl5.5.640.dist/toke.c perl5.5.640/toke.c
--- perl5.5.640.dist/toke.c Mon Jan 31 22:00:22 2000
+++ perl5.5.640/toke.c Mon Feb 7 15:11:07 2000
@@ -4174,6 +4174,9 @@
case KEY_getlogin:
FUN0(OP_GETLOGIN);
+ case KEY_gethostname:
+ FUN0(OP_GHNAME);
+
case KEY_glob:
set_csh();
LOP(OP_GLOB,XTERM);
@@ -5087,6 +5090,7 @@
if (strEQ(d,"hostbyname")) return -KEY_gethostbyname;
if (strEQ(d,"hostbyaddr")) return -KEY_gethostbyaddr;
if (strEQ(d,"hostent")) return -KEY_gethostent;
+ if (strEQ(d,"hostname")) return -KEY_gethostname;
}
else if (*d == 'n') {
if (strEQ(d,"netbyname")) return -KEY_getnetbyname;
Thread Next
-
[PATCH 5.5.640] add gethostname() (was Re: fixing Sys::Hostname)
by Greg Bacon