fpc/packages/utmp/utmp.pp

unit Utmp;

interface

uses
  Linux;

const
  Device_name_length = 12;
  Host_name_length = 245;
  User_name_length = 32;

type
  tTime = Longint;
  tPid = Longint;
  tIP_Address = array[1..4] of Byte;
  tDevice_name = String[Device_name_length];
  tUser_name = String[User_name_length];
  tHost_name = String[Host_name_length];
  tLogin_type = (Unkown, Run_level, Boot_time, New_time, Old_time, 
    Init_process, Login_process, User_process, Dead_process);
  tLogin_types = set of tLogin_type;
  tParameter_type = (Include, Exclude);

{$PACKRECORD 1}
  tUser = record
    Type_of_login : tLogin_type;
    Pid           : tPid;
    Device        : tDevice_name;
    Tty_name      : String[4];
    Login_time    : tTime;
    User_name     : tUser_name;
    Host_name     : tHost_name;
    IP_Address    : tIP_Address;
  end;
  pUser = ^tUser;

Const
  DefaultLoginType : TLogin_Types = [User_Process];
  Login_type_names : array [TLogin_type] of string[20] = 
  ('Unkown', 'Run level', 'Boot time','New time', 'Old time', 
    'Init process', 'Login process', 'User process', 'Dead process');
 All_Login_types : TLogin_types = [Unkown, Run_level, Boot_time, New_time, Old_time, 
    Init_process, Login_process, User_process, Dead_process];
    
procedure Read_logged_users;
function Get_next_user : tUser;
function Get_next_user(var Last : Boolean) : tUser;
procedure Set_search_parameters(
  const Parameter_type : tParameter_type; 
  Login_types : tLogin_types);
procedure Reset_user_search;
function More_users : Boolean;
function Number_of_logged_users : Word;


{Low level rutines}
function Number_of_utmp_entries : Word;
procedure Set_utmp_file(const File_name : String);


type
  texitstatus = record
    e_termination,
    e_exit : integer;
    end;
    
  tLL_Utmp = record 
    ut_type : integer;
    ut_pid : longint;
    ut_line : tdevice_name;
    ut_id : array[1..4] of char;
    ut_user : tuser_name;
    ut_host : thost_name;
    ut_exit : texitstatus;
    ut_session : longint;
    ut_tv : Array [1..2] of longint;
    ut_addr : Array[1..4] of longint;
    pad : array [1..48] of char
    end;
  pUser_list = ^tUser_list;
  tUser_list = record
    User : tUser;
    Next : pUser_list;
  end;

implementation

Type
  tSearch_parameters = record
    Type_of_login_types : tParameter_type;
    Login_types         : tLogin_types;
  end;
  
var
  User_list           : pUser_list;
  Current_user        : pUser_list;
  Utmp_file           : String;
  Search_parameters   : tSearch_parameters;
  
  procedure Set_search_parameters(
    const Parameter_type : tParameter_type;
    Login_types : tLogin_types);
    
  begin
    Search_parameters.Type_of_login_types := Parameter_type;
    Search_parameters.Login_types := Login_types;
  end;
  
  function More_users : Boolean;
  
  var
    UL   : pUser_list;
    Last : Boolean;
  
  begin
    UL := Current_user;
    Last := True;
      while (UL <> nil) and Last do begin
          if Search_parameters.Type_of_login_types = Exclude then begin
            Last := (UL^.User.Type_of_login in Search_parameters.Login_types);
          end else begin
            Last := not (UL^.User.Type_of_login in Search_parameters.Login_types);
          end; 
        UL := UL^.Next;
      end;
    More_users := not Last;
  end;
  
  function Number_of_logged_users : Word;
  
  var
    I : Word;
    UL: pUser_list;
  
  begin
    I := 0;
    UL := User_list;
      while UL <> nil do begin
          if UL^.User.Type_of_login = User_process then begin
            I := I + 1;
          end;
        UL := UL^.Next;
      end;
    Number_of_logged_users := I;
  end;
  
  function Get_next_user : tUser;
  
  var
    Found : Boolean;
    User  : pUser;
  
  begin
    if Current_user <> nil then begin
      Found := False;
        while (Current_user <> nil) and not Found do begin
          User := @Current_user^.User;
            if Search_parameters.Type_of_login_types = Exclude then begin
              Found := not (User^.Type_of_login in Search_parameters.Login_types);
            end else begin
              Found := (User^.Type_of_login in Search_parameters.Login_types);
            end;
          Current_user := Current_user^.Next;
        end;
        if Found then begin
          Get_next_user := User^;
        end else begin
          New(User);
          FillChar(User^, SizeOf(tUser), 0);
          Get_next_user := User^;
          Dispose(User);
        end;
    end else begin
      New(User);
      FillChar(User^, SizeOf(tUser), 0);
      Get_next_user := User^;
      Dispose(User);
    end;
  end;
  
  function Get_next_user(var Last : Boolean) : tUser;
  
  var
    Found : Boolean;
    User  : pUser;
    UL    : pUser_list;
  
  begin
    if Current_user <> nil then begin
      Found := False;
        while (Current_user <> nil) and not Found do begin
          User := @Current_user^.User;
            if Search_parameters.Type_of_login_types = Exclude then begin
              Found := not (User^.Type_of_login in Search_parameters.Login_types);
            end else begin
              Found := (User^.Type_of_login in Search_parameters.Login_types);
            end;
          Current_user := Current_user^.Next;
        end;
        if Found then begin
          Get_next_user := User^;
          UL := Current_user;
          Last := True;
            while (UL <> nil) and Last do begin
                if Search_parameters.Type_of_login_types = Exclude then begin
                  Last := (UL^.User.Type_of_login in Search_parameters.Login_types);
                end else begin
                  Last := not (UL^.User.Type_of_login in Search_parameters.Login_types);
                end;
              UL := UL^.Next;
            end;
        end else begin
          New(User);
          FillChar(User^, SizeOf(tUser), 0);
          Get_next_user := User^;
          Dispose(User);
        end;
    end else begin
      New(User);
      FillChar(User^, SizeOf(tUser), 0);
      Get_next_user := User^;
      Dispose(User);
    end;
  end;
  
  procedure Reset_user_search;
  
  begin
    Current_user := User_list;
  end;
  
  procedure Set_utmp_file(const File_name : String);
  
  begin
    Utmp_file := File_name;
  end;
  
  function Number_of_utmp_entries : Word;

  var
    S : Stat;
    
  begin
    Linux.FStat(Utmp_file, S);
    Number_of_utmp_entries := S.Size div System.SizeOf(tLL_Utmp);
  end;


  procedure Read_logged_users;
 
    procedure Read_entry(var F : File; var Entry : tUser; var User : Boolean);
    
    var
      LL_Entry : tLL_Utmp;
      I        : Byte;
    
    begin
      BlockRead(F, LL_Entry, SizeOf(tLL_Utmp));
      Byte(Entry.Type_of_login) := LL_Entry.ut_type;
      Entry.Pid := Longint(LL_Entry.ut_id);
      Entry.Device:=LL_entry.ut_line;
      Entry.TTy_Name:=LL_Entry.ut_id;
      Entry.Login_time := LL_Entry.ut_tv[1];
      Entry.User_name:=LL_entry.ut_user;
      Entry.Host_name:=LL_entry.ut_host;  
      For I:=1 to 4 do
          Entry.Ip_Address[I] := LL_Entry.ut_addr[i];
    end;

  var
    F : File;
    I : Longint;
    UL: pUser_list;
    U : Boolean;
    
  begin
    System.Assign(F, Utmp_file);
{$IFOPT I+}
{$DEFINE I_was_on}
{$ENDIF}
{$I-}
    System.Reset(F,1);
{$IFDEF I_was_on}
{$UNDEF I_was_on}
{$I+}
{$ENDIF}
    UL := User_list;
      while UL <> nil do begin
        User_list := UL;
        UL := UL^.Next;
        Dispose(User_list);
      end;
    User_list := nil;
      if System.IOResult = 0 then begin
          for I := 1 to Number_of_utmp_entries do begin
              if User_list = nil then begin
                New(User_list);
                UL := User_list;
                UL^.Next := nil;
              end else begin
                New(UL^.Next);
                UL := UL^.Next;
                UL^.Next := nil;
              end;
            Read_entry(F, UL^.User, U);
          end;
        UL^.Next := nil;
      end else begin
        User_list := nil;
      end;
    System.Close(F);
    Current_user := User_list;
  end;

begin
  User_list := nil;
  Current_user := nil;
  Utmp_file := '/var/run/utmp';
  Set_search_parameters(Include,DefaultLoginType);
end.