-- ***************************************************************************** -- $Id: rexec_t.m4,v 1.2 1993/01/25 15:33:31 courtel Exp $ -- -- Kind: Test procedure -- Abstract: Test REXEC Ada version -- Review: -- Portable: YES -- -- Copyright 1993 Centre d'Etudes de la Navigation Aerienne (CENA) -- ***************************************************************************** with INET, NETWORK, PROCESS, SIGNAL, FILE; with SYSTEM, DEBUG; procedure REXEC_TEST is -- ************************************************************************** -- OUTLINE: Execute a process on a remote machine like rsh(1), using the -- REXEC procedure. The remote process is given an amount of time, after -- which it is remotely killed. -- ************************************************************************** MAX_TIME: constant DURATION := 4.0; package NET renames NETWORK; package SIG renames SIGNAL; BUFSIZE: constant := 1024; subtype BUFFER is STRING (1 .. BUFSIZE); -- To read remote command output BUF: BUFFER; BUFLEN: NATURAL; procedure BUF_READ is new FILE.READ (BUFFER, FORCE_FILL => FALSE); procedure BUF_WRITE is new FILE.WRITE (BUFFER); HOST: NET.HOSTNAME; PORT: INET.IPPORT; RIO: FILE.DESCRIPTOR; -- Remote Input/Output IO_OPEN: BOOLEAN := TRUE; RERR: FILE.DESCRIPTOR; -- Remote Error ERR_OPEN: BOOLEAN := TRUE; BYTES_SENT: NATURAL; LEFT_OPEN: FILE.DESCRIPTOR_SET; ARG_ERROR: exception; -- ************************************************************************** -- Kill remote command when it is taking to much time -- ************************************************************************** task TIME_OUT is entry START (FD: in FILE.DESCRIPTOR; HOW_LONG: in DURATION); entry STOP; end TIME_OUT; task body TIME_OUT is procedure REMOTE_KILL is new FILE.WRITE (SIG.SIGNALS); TARGET: FILE.DESCRIPTOR; WAIT_TIME: DURATION; SIG_SIZE: constant := SIG.SIGNALS'size / SYSTEM.STORAGE_UNIT; BYTES_SENT: NATURAL; begin accept START (FD: in FILE.DESCRIPTOR; HOW_LONG: in DURATION) do TARGET := FD; WAIT_TIME := HOW_LONG; end; select accept STOP; or delay WAIT_TIME; DEBUG.WARNING ("Time out: killing remote process"); REMOTE_KILL (TARGET, SIG.INT, SIG_SIZE, BYTES_SENT); if BYTES_SENT < SIG_SIZE then DEBUG.ERROR ("Remote kill failed"); end if; end select; end TIME_OUT; -- ************************************************************************** begin if PROCESS.ARGC < 3 then raise ARG_ERROR; end if; HOST := (PROCESS.ARGL (1), PROCESS.ARGV (1)); PORT := NET.GETSERVBYNAME ("exec").S_PORT; -- Build the command with all the following parameters BUF (1 .. PROCESS.ARGL (2)) := PROCESS.ARGV (2); BUFLEN := PROCESS.ARGL (2); for I in 3 .. POSITIVE'pred (PROCESS.ARGC) loop BUF (BUFLEN + 1) := ' '; BUF (BUFLEN + 2 .. BUFLEN + 1 + PROCESS.ARGL (I)) := PROCESS.ARGV (I); BUFLEN := BUFLEN + 1 + PROCESS.ARGL (I); end loop; DEBUG.WARNING ("Executing " & BUF (1 .. BUFLEN) & " on host " & HOST.NAME); FILE.REXEC (HOST, PORT, CMD => BUF (1 .. BUFLEN), FD1P => RIO, FD2P => RERR); TIME_OUT.START (RERR, MAX_TIME); while IO_OPEN or ERR_OPEN loop if IO_OPEN then begin loop BUF_READ (RIO, BUF, BUFSIZE, BUFLEN); BUF_WRITE (FILE.STDOUT, BUF, BUFLEN, BYTES_SENT); exit when BUFLEN < BUFSIZE; end loop; exception when FILE.END_ERROR => FILE.CLOSE (RIO); IO_OPEN := FALSE; end; end if; if ERR_OPEN then begin loop BUF_READ (RERR, BUF, BUFSIZE, BUFLEN); DEBUG.ERROR ("Remote error:"); BUF_WRITE (FILE.STDERR, BUF, BUFLEN, BYTES_SENT); exit when BUFLEN < BUFSIZE; end loop; exception when FILE.END_ERROR => FILE.CLOSE (RERR); ERR_OPEN := FALSE; end; end if; end loop; TIME_OUT.STOP; LEFT_OPEN := FILE.CLEANUP; exception when ARG_ERROR => DEBUG.ERROR ("Usage: " & PROCESS.ARGV (0) & " [parameters] ..."); PROCESS.C_EXIT (1); when others => PROCESS.C_EXIT (255); end REXEC_TEST;