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

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;