Return to machines.adb CVS log

Up to [local] / OpenXM_contrib / PHC / Ada / System

Annotation of OpenXM_contrib/PHC/Ada/System/machines.adb, Revision 1.1

1.1     ! maekawa     1: with System_Call;
        !             2: with text_io,integer_io;            use text_io,integer_io;
        !             3:
        !             4: package body Machines is
        !             5:
        !             6:   function getpid return integer;
        !             7:   pragma interface(C, getpid);
        !             8:
        !             9:   function Process_ID return integer is
        !            10:   begin
        !            11:     return getpid;
        !            12:   end Process_ID;
        !            13:
        !            14:   function Integer_to_String ( i : integer ) return string is
        !            15:
        !            16:     answer : string(1..20);
        !            17:     nb : natural := 0;
        !            18:     tmp : integer := i;
        !            19:
        !            20:     function Number_to_Character ( n : integer ) return character is
        !            21:     begin
        !            22:       case n is
        !            23:        when 0 => return '0';
        !            24:        when 1 => return '1';
        !            25:        when 2 => return '2';
        !            26:        when 3 => return '3';
        !            27:        when 4 => return '4';
        !            28:        when 5 => return '5';
        !            29:        when 6 => return '6';
        !            30:        when 7 => return '7';
        !            31:        when 8 => return '8';
        !            32:        when 9 => return '9';
        !            33:        when others => return ' ';
        !            34:       end case;
        !            35:     end Number_to_Character;
        !            36:
        !            37:   begin
        !            38:     if tmp = 0
        !            39:      then nb := nb + 1;
        !            40:          answer(nb) := Number_to_Character(0);
        !            41:     end if;
        !            42:     while tmp /= 0 loop
        !            43:       nb := nb + 1;
        !            44:       answer(nb) := Number_to_Character(tmp mod 10);
        !            45:       tmp := tmp / 10;
        !            46:     end loop;
        !            47:     declare
        !            48:       res : string(1..nb);
        !            49:     begin
        !            50:       for j in res'range loop
        !            51:        res(j) := answer(nb-j+1);
        !            52:       end loop;
        !            53:       return res;
        !            54:     end;
        !            55:   end Integer_to_String;
        !            56:
        !            57:   function Process_ID return string is
        !            58:   begin
        !            59:     return Integer_to_String(getpid);
        !            60:   end Process_ID;
        !            61:
        !            62:   function User_Name ( pid : string ) return string is
        !            63:
        !            64:     temp : file_type;
        !            65:     name : string(1..80);
        !            66:     last : natural;
        !            67:
        !            68:   begin
        !            69:     System_Call.Call("whoami > /tmp/user_name" & pid);
        !            70:     Open(temp,in_file,"/tmp/user_name" & pid);
        !            71:     get_line(temp,name,last);
        !            72:     Close(temp);
        !            73:     System_Call.Call("rm /tmp/user_name" & pid);
        !            74:     return name(1..last);
        !            75:   exception
        !            76:     when others => return "???";
        !            77:   end User_Name;
        !            78:
        !            79:   function Architecture ( pid : string ) return string is
        !            80:
        !            81:     temp : file_type;
        !            82:     answer : string(1..80);
        !            83:     last : natural;
        !            84:
        !            85:   begin
        !            86:     System_Call.Call("uname -a > /tmp/arch_type" & pid);
        !            87:     Open(temp,in_file,"/tmp/arch_type" & pid);
        !            88:     get_line(temp,answer,last);
        !            89:     Close(temp);
        !            90:     System_Call.Call("rm /tmp/arch_type" & pid);
        !            91:     return answer(1..last);
        !            92:   exception
        !            93:     when others => return "???";
        !            94:   end Architecture;
        !            95:
        !            96:   function Architecture ( pid : string; machine : string ) return string is
        !            97:
        !            98:     temp : file_type;
        !            99:     answer : string(1..80);
        !           100:     last : natural;
        !           101:
        !           102:   begin
        !           103:     System_Call.Call("rsh " &  machine & " uname -a > /tmp/arch_type" & pid);
        !           104:     Open(temp,in_file,"/tmp/arch_type" & pid);
        !           105:     get_line(temp,answer,last);
        !           106:     Close(temp);
        !           107:     System_Call.Call("rm /tmp/arch_type" & pid);
        !           108:     return answer(1..last);
        !           109:   exception
        !           110:     when others => return "???";
        !           111:   end Architecture;
        !           112:
        !           113:   function Host_Name ( pid : string ) return string is
        !           114:
        !           115:     temp : file_type;
        !           116:     answer : string(1..80);
        !           117:     last : natural;
        !           118:
        !           119:   begin
        !           120:     System_Call.Call("hostname > /tmp/host_name" & pid);
        !           121:     Open(temp,in_file,"/tmp/host_name" & pid);
        !           122:     get_line(temp,answer,last);
        !           123:     Close(temp);
        !           124:     System_Call.Call("rm /tmp/host_name" & pid);
        !           125:     return answer(1..last);
        !           126:   exception
        !           127:     when others => return "???";
        !           128:   end Host_Name;
        !           129:
        !           130:   function Date ( pid : string ) return string is
        !           131:
        !           132:     temp : file_type;
        !           133:     answer : string(1..80);
        !           134:     last : natural;
        !           135:
        !           136:   begin
        !           137:     System_Call.Call("date > /tmp/date" & pid);
        !           138:     Open(temp,in_file,"/tmp/date" & pid);
        !           139:     get_line(temp,answer,last);
        !           140:     Close(temp);
        !           141:     System_Call.Call("rm /tmp/date" & pid);
        !           142:     return answer(1..last);
        !           143:   exception
        !           144:     when others => return "???";
        !           145:   end Date;
        !           146:
        !           147: end Machines;