38 lines
873 B
Perl
38 lines
873 B
Perl
|
#
|
|||
|
# 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;
|