require 'utmp.ph';

package utmp;

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

#### from </usr/include/utmp.h> :
#struct utmp {
#	char ut_user[8];		/* User login name */
#	char ut_id[4]; 			/* /etc/inittab id(usually line #) */
#	char ut_line[12];		/* device name (console, lnxx) */
#	short ut_pid;			/* short for compat. - process id */
#	short ut_type;			/* type of entry */
#	struct exit_status ut_exit;	/* The exit status of a process */
#					/* marked as DEAD_PROCESS. */
#	time_t ut_time;			/* time entry was made */
#};

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

#### from </usr/include/types.h> :
#typedef	long		time_t;	/* time of day in seconds */

sub struct_unpack # (packed_struct_utmp)
{
    local(@s) = unpack("a8 a4 a12 S S SS L", @_[ $[ ]);
    # 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;
    return @s;
}

sub struct_pack # (ut_user, ut_id, ut_line, ut_pid, ut_type,
#		ut_exit.e_termination, ut_exit.e_exit, ut_time)
{
    return pack("a8 a4 a12 S S SS L", @_);
}

$struct_length = length(&struct_pack());

$filename = &main'UTMP_FILE;

### external interface...

sub main'utmpname # (file)
{
    close(UTMP) if $utmp_open;
    $filename = @_[ $[ ];
    undef $utmp_open;
    1;
}

sub main'setutent
{
    return ($utmp_open = open(UTMP, $filename));
}

sub main'endutent
{
    $utmp_open = 0;
    close(UTMP);
}

sub main'getutent
{
    local($data);
    &main'setutent unless $utmp_open;
    (read(UTMP, $data, $struct_length) == $struct_length) || return undef;
    return &struct_unpack($data);
}

sub main'getutid # (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(UTMP, $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'getutline # (line)
{
    local($Qline) = @_;
    local($data, @data);
    while(1) {
	(read(UTMP, $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;