require 'utmpx.ph';

package utmpx;

######### Solaris #########

#### from </usr/include/utmpx.h> :
#struct utmpx {
#	char	ut_user[32];		/* user login name */
#	char	ut_id[4];		/* inittab id */
#	char	ut_line[32];		/* device name (console, lnxx) */
#	pid_t	ut_pid;			/* process id */
#	short	ut_type;		/* type of entry */
#	struct exit_status ut_exit;	/* process termination/exit status */
#	struct timeval ut_tv;		/* time entry was made */
#	long	ut_session;		/* session ID, used for windowing */
#	long	pad[5];			/* reserved for future use */
#	short	ut_syslen;		/* significant length of ut_host */
#					/*   including terminating null */
#	char	ut_host[257];		/* remote host name */
#};

#### from </usr/include/utmp.h> :
#struct exit_status {
#	short e_termination;	/* Process termination status */
#	short e_exit;		/* Process exit status */
#};

#### from </usr/include/sys/types.h> :
#typedef long	pid_t;			/* process id type	*/

#### from </usr/include/sys/time.h> :
#struct timeval {
#	long	tv_sec;		/* seconds */
#	long	tv_usec;	/* and microseconds */
#};

sub struct_unpack # (packed_struct_utmpx)
{
    local($[) = 0;
    # (S) is alignment padding.
    local(@s) = (unpack("a32 a4 a32 L S SS (S)LL L L5 S a257", @_[0]))
	[0..6,8..10,17];
    # removing trailing nulls isn't enough, everything after a null must go.
    $s[0] =~ s/\000.*//g;
    $s[1] =~ s/\000.*//g;
    $s[2] =~ s/\000.*//g;
    $s[10]=~ s/\000.*//g;
    return @s;
}

sub struct_pack # (ut_user, ut_id, ut_line, ut_pid, ut_type,
#		ut_exit.e_termination, ut_exit.e_exit,
#               ut_tv.tv_sec, [ut_tv.tv_usec, ut_session, ut_host])
{
    local($[) = 0;
    # ()s indicate alignment padding.
    return pack("a32 a4 a32 L S SS (S)LL L L5 S a258",
		@_[0..9], 0,0,0,0,0, length(@_[10])+1, @_[10]);
}

$struct_length = length(&struct_pack());

$filename = &main'UTMPX_FILE;

### external interface...

sub main'utmpxname # (file)
{
    close(UTMPX) if $utmpx_open;
    $filename = @_[ $[ ];
    undef $utmpx_open;
    1;
}

sub main'setutxent
{
    return ($utmpx_open = open(UTMPX, $filename));
}

sub main'endutxent
{
    $utmpx_open = 0;
    close(UTMPX);
}

sub main'getutxent
{
    local($data);
    &main'setutxent unless $utmpx_open;
    (read(UTMPX, $data, $struct_length) == $struct_length) || return undef;
    return &struct_unpack($data);
}

sub main'getutxid # (type, [id])
{
    local($Qtype, $Qid) = @_;
    local($procQtype) = (($Qtype == &main'INIT_PROCESS) ||
			 ($Qtype == &main'LOGIN_PROCESS) ||
			 ($Qtype == &main'USER_PROCESS) ||
			 ($Qtype == &main'DEAD_PROCESS));
    local($data, @data);
    while(1) {
	(read(UTMPX, $data, $struct_length) == $struct_length) || return undef;
	@data = &struct_unpack($data);   # user, id, line, pid, type...
	if ($procQtype) {
	    # This is ikky.  Read the man page if you want to know why.
	    if ( ($data[1] eq $Qid) && (($data[4] == &main'INIT_PROCESS) ||
					($data[4] == &main'LOGIN_PROCESS) ||
					($data[4] == &main'USER_PROCESS) ||
					($data[4] == &main'DEAD_PROCESS)) ) {
		return @data;
	    }
	} else {
	    if ($type == $Qtype) {
		return @data;
	    }
	}
    }
}

sub main'getutxline # (line)
{
    local($Qline) = @_;
    local($data, @data);
    while(1) {
	(read(UTMPX, $data, $struct_length) == $struct_length) || return undef;
	@data = &struct_unpack($data);   # user, id, line, pid, type...
	if (($data[2] eq $Qline) || ($data[4] == &main'LOGIN_PROCESS)) {
	    return @data;
	}
    }
}

1;