Several changes to the gethostname module:

. rename the function to main'gethostname, so it can be called unqualified,
. strip the trailing \0 character, closes PR # bin/1084,
. a better way to express an insane long string.

Submitted by:	Giles Lean <giles@topaz.nemeton.com.au> (except the 1st)
This commit is contained in:
Joerg Wunsch 1996-03-18 21:42:31 +00:00
parent 4c2aa33eb8
commit 8aa07454ea

View File

@ -4,7 +4,7 @@
# Written 13-Feb-96 by Jörg Wunsch, interface business GmbH Dresden.
# Placed in the public domain.
#
# $Id$
# $Id: gethostname.pl,v 1.1 1996/02/13 13:17:49 joerg Exp $
#
package gethostname;
@ -16,22 +16,21 @@ require "sys/sysctl.ph";
# usage:
#
# require "gethostname.pl";
# printf "This machine is named \"%s\".\n", &gethostname'gethostname;
# printf "This machine is named \"%s\".\n", &gethostname;
#
sub gethostname {
sub main'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 =
" ";
$oldval = " " x 64;
$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);
return substr($oldval, 0, $len - 1);
}
1;