Add a small `gethostname' package. It uses __sysctl(2), and thus
avoids the kludgy backquotes that are required by now (`hostname`). Usage: require "gethostname.pl"; $thishost = &gethostname'gethostname;
This commit is contained in:
parent
796e5c4e86
commit
ed7c1e1183
@ -2,9 +2,9 @@ PLIBDIR= ${DESTDIR}/usr/share/perl
|
||||
|
||||
PLIB+= abbrev.pl assert.pl bigfloat.pl bigint.pl bigrat.pl cacheout.pl
|
||||
PLIB+= chat2.pl complete.pl ctime.pl dumpvar.pl exceptions.pl fastcwd.pl
|
||||
PLIB+= find.pl finddepth.pl flush.pl getcwd.pl getopts.pl importenv.pl
|
||||
PLIB+= look.pl newgetopt.pl open2.pl perldb.pl pwd.pl shellwords.pl
|
||||
PLIB+= stat.pl syslog.pl termcap.pl timelocal.pl validate.pl
|
||||
PLIB+= find.pl finddepth.pl flush.pl getcwd.pl gethostname.pl getopts.pl
|
||||
PLIB+= importenv.pl look.pl newgetopt.pl open2.pl perldb.pl pwd.pl
|
||||
PLIB+= shellwords.pl stat.pl syslog.pl termcap.pl timelocal.pl validate.pl
|
||||
|
||||
NOOBJ=
|
||||
|
||||
|
37
gnu/usr.bin/perl/lib/gethostname.pl
Normal file
37
gnu/usr.bin/perl/lib/gethostname.pl
Normal file
@ -0,0 +1,37 @@
|
||||
#
|
||||
# Simple package to get the hostname via __sysctl(2).
|
||||
#
|
||||
# Written 13-Feb-96 by Jörg Wunsch, interface business GmbH Dresden.
|
||||
# Placed in the public domain.
|
||||
#
|
||||
# $Id$
|
||||
#
|
||||
|
||||
package gethostname;
|
||||
|
||||
require "sys/syscall.ph";
|
||||
require "sys/sysctl.ph";
|
||||
|
||||
#
|
||||
# usage:
|
||||
#
|
||||
# require "gethostname.pl";
|
||||
# printf "This machine is named \"%s\".\n", &gethostname'gethostname;
|
||||
#
|
||||
|
||||
sub gethostname {
|
||||
# get hostname via sysctl(2)
|
||||
local($name, $oldval, $oldlen, $len);
|
||||
$name = pack("LL", &CTL_KERN, &KERN_HOSTNAME);
|
||||
# 64-byte string to get the hostname
|
||||
$oldval =
|
||||
" ";
|
||||
$oldlen = pack("L", length($oldval));
|
||||
syscall(&SYS___sysctl, $name, 2, $oldval, $oldlen, 0, 0) != -1 ||
|
||||
die "Cannot get hostname via sysctl(2), errno = $!\n";
|
||||
|
||||
($len) = unpack("L", $oldlen);
|
||||
return substr($oldval, 0, $len);
|
||||
}
|
||||
|
||||
1;
|
Loading…
Reference in New Issue
Block a user