------------------------------------------------------------------------------ -- BUSH Text_IO Package -- -- -- -- Part of BUSH -- ------------------------------------------------------------------------------ -- -- -- Copyright (C) 2001-2005 Ken O. Burtch & FSF -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- -- ware Foundation; either version 2, or (at your option) any later ver- -- -- sion. This is distributed in the hope that it will be useful, but WITH- -- -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- -- for more details. You should have received a copy of the GNU General -- -- Public License distributed with this; see file COPYING. If not, write -- -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- -- MA 02111-1307, USA. -- -- -- -- This is maintained at http://www.pegasoft.ca -- -- -- ------------------------------------------------------------------------------ -- CVS: $Id: parser_tio.adb,v 1.2 2005/02/11 02:59:29 ken Exp $ with ada.text_io.editing, ada.strings.unbounded.text_io, string_util, user_io, script_io, signal_flags, scanner.calendar, parser_cal, parser; use ada.text_io, ada.text_io.editing, ada.strings.unbounded, ada.strings.unbounded.text_io, user_io, script_io, string_util, signal_flags, scanner.calendar, parser_cal, parser; package body parser_tio is procedure ParseIsOpen( b : out identifier ) is -- is_open( file ) -- Ada.Text_IO.Is_Open file : identifier; begin b := false_t; getNextToken; expect( symbol_t, "(" ); ParseIdentifier( file ); expect( symbol_t, ")" ); if file = standard_output_t then b := true_t; elsif file = standard_error_t then b := true_t; elsif uniTypesOk( identifiers( file ).kind, file_type_t ) then if length( identifiers( file ).value ) > 0 then b := true_t; end if; end if; end ParseIsOpen; procedure ParseEndOfFile( result : out unbounded_string ) is -- Syntax: End_of_file( f ) -- Source: Ada.Text_IO.End_Of_File file_ref : reference; kind : identifier; begin result := to_unbounded_string( boolean'image( false ) ); getNextToken; expect( symbol_t, "(" ); ParseOpenFileOrSocket( file_ref, kind ); if isExecutingCommand then if kind = file_type_t then if identifier'value( to_string( stringField( file_ref, mode_field ) ) ) /= in_file_t then err( "end_of_file only applies to " & optional_bold( "in_mode" ) & " files" ); end if; end if; end if; expect( symbol_t, ")" ); if isExecutingCommand then result := stringField( file_ref, eof_field ); end if; end ParseEndOfFile; procedure ParseEndOfLine( result : out unbounded_string ) is -- Syntax: end_of_line( open-file ) -- Source: Ada.Text_IO.End_Of_Line file_ref : reference; begin result := to_unbounded_string( integer'image( 0 ) ); getNextToken; expect( symbol_t, "(" ); ParseOpenFile( file_ref ); expect( symbol_t, ")" ); if isExecutingCommand then result := stringField( file_ref, eol_field ); end if; end ParseEndOfLine; procedure ParseLine( result : out unbounded_string ) is -- Syntax: line( open-file ) -- Source: Ada.Text_IO.Line file_ref : reference; begin result := to_unbounded_string( integer'image( 0 ) ); getNextToken; expect( symbol_t, "(" ); ParseOpenFile( file_ref ); expect( symbol_t, ")" ); if isExecutingCommand then result := stringField( file_ref, line_field ); end if; end ParseLine; procedure ParseName( result : out unbounded_string ) is -- Syntax: name( open-file ) -- Source: Ada.Text_IO.Name file_ref : reference; begin result := null_unbounded_string; getNextToken; expect( symbol_t, "(" ); ParseOpenFile( file_ref ); expect( symbol_t, ")" ); if isExecutingCommand then result := stringField( file_ref, name_field ); end if; end ParseName; procedure ParseMode( result : out unbounded_string ) is -- Syntax: mode( open-file ) -- Source: Ada.Text_IO.Mode file_ref : reference; begin result := null_unbounded_string; getNextToken; expect( symbol_t, "(" ); ParseOpenFile( file_ref ); expect( symbol_t, ")" ); if isExecutingCommand then result := stringField( file_ref, mode_field ); if identifier'value( to_string( result ) ) = in_file_t then result := identifiers( in_file_t ).value; elsif identifier'value( to_string( result ) ) = out_file_t then result := identifiers( out_file_t ).value; elsif identifier'value( to_string( result ) ) = append_file_t then result := identifiers( append_file_t ).value; else err( "internal error: unable to determine file mode" ); end if; end if; end ParseMode; procedure ParseInkey( str : out unbounded_string ) is -- Syntax: inkey -- Source: Ada.Text_IO.Inkey ch : character; begin expect( inkey_t ); if isExecutingCommand then getKey( ch ); if wasSIGINT then null; end if; str := to_unbounded_string( ch & "" ); end if; end ParseInkey; procedure ParseGetLine( str : out unbounded_string ) is -- Syntax: get_line [ (open-file) ] -- Source: Ada.Text_IO.Get_Line -- Note: Gnat get_line can't be used here because it does something -- odd with file descriptor 0 file_ref : reference; kind : identifier; --fd : aFileDescriptor; ch : character; --result : long_integer; fileInfo : unbounded_string; begin file_ref.id := eof_t; str := null_unbounded_string; getNextToken; if token = symbol_t and then identifiers( Token ).value = "(" then expect( symbol_t, "(" ); ParseOpenFileOrSocket( file_ref, kind ); expect( symbol_t, ")" ); end if; if isExecutingCommand then if file_ref.id /= eof_t then if trace then put_trace( "Input from file descriptor" & to_string( stringField( file_ref, fd_field ) ) ); end if; if kind = socket_type_t and then stringField( file_ref, doget_field ) = "1" then DoGet( file_ref ); replaceField( file_ref, doget_field, boolean'image( false ) ); end if; loop GetParameterValue( file_ref, fileInfo ); ch := Element( fileInfo, 1 ); if stringField(file_ref, eof_field ) = "1" then err( "end of file" ); exit; end if; DoGet( file_ref ); exit when ch = ASCII.LF or error_found or wasSIGINT; str := str & ch; end loop; else getLine( str ); if wasSIGINT then new_line; -- user didn't press enter -- wasSIGINT will be cleared later end if; end if; end if; end ParseGetLine; procedure ParseOpenFile( return_ref : out reference ) is -- standard output, standard error or a user file -- the file must be closed (ie value of variable is null) ref : reference; begin ref.id := eof_t; return_ref.id := eof_t; -- assume failure -- Special Files: Current_Input, Current_Output and Current_Error -- are aliases for a different file variable. For example, by default, -- Current_Output refers to Standard_Output. These variables must be -- "dereferenced" to the actual file they represent so that the file -- info (such as eof) are accurately updated in the original file -- variable. -- Since Standard_Input, Standard_Output and Standard_Error are (now) -- represented as true file variables, they need no special treatment. if token = current_input_t then if isExecutingCommand then ref.id := identifier( to_numeric( identifiers(current_input_t).value ) ); end if; getNextToken; elsif token = current_output_t then if isExecutingCommand then ref.id := identifier( to_numeric( identifiers(current_output_t).value ) ); end if; getNextToken; elsif token = current_error_t then if isExecutingCommand then ref.id := identifier( to_numeric( identifiers(current_error_t).value ) ); end if; getNextToken; else ParseInOutParameter( ref ); if getUniType( ref.kind ) /= file_type_t then err( "file_type expected" ); end if; end if; -- Verify that the identifier is a file. Unless during a syntax check, -- verify that the file is also open (files are not opened during a -- syntax check). if not syntax_check then if length( identifiers( ref.id ).value ) = 0 then err( "file not open" ); elsif not error_found then return_ref := ref; end if; end if; end ParseOpenFile; procedure ParseOpenSocket( return_ref : out reference ) is -- standard output, standard error or a user file -- the file must be closed (ie value of variable is null) ref : reference; begin ref.id := eof_t; return_ref.id := eof_t; -- assume failure -- Special Files: Current_Input, Current_Output and Current_Error -- are aliases for a different file variable. For example, by default, -- Current_Output refers to Standard_Output. These variables must be -- "dereferenced" to the actual file they represent so that the file -- info (such as eof) are accurately updated in the original file -- variable. -- Since Standard_Input, Standard_Output and Standard_Error are (now) -- represented as true file variables, they need no special treatment. if token = current_input_t then if isExecutingCommand then ref.id := identifier( to_numeric( identifiers(current_input_t).value ) ); end if; getNextToken; elsif token = current_output_t then if isExecutingCommand then ref.id := identifier( to_numeric( identifiers(current_output_t).value ) ); end if; getNextToken; elsif token = current_error_t then if isExecutingCommand then ref.id := identifier( to_numeric( identifiers(current_error_t).value ) ); end if; getNextToken; else ParseInOutParameter( ref ); if getUniType( ref.kind ) /= socket_type_t then err( "file_type or socket_type variable expected" ); end if; end if; -- Verify that the identifier is a socket. Unless during a syntax check, -- verify that the socket is also open (sockets are not opened during a -- syntax check). if not syntax_check then if length( identifiers( ref.id ).value ) = 0 then err( "file not open" ); elsif not error_found then return_ref := ref; end if; end if; end ParseOpenSocket; procedure ParseOpenFileOrSocket( return_ref : out reference; kind : out identifier ) is -- standard output, standard error or a user file -- the file must be closed (ie value of variable is null) ref : reference; begin ref.id := eof_t; return_ref.id := eof_t; -- assume failure -- Special Files: Current_Input, Current_Output and Current_Error -- are aliases for a different file variable. For example, by default, -- Current_Output refers to Standard_Output. These variables must be -- "dereferenced" to the actual file they represent so that the file -- info (such as eof) are accurately updated in the original file -- variable. -- Since Standard_Input, Standard_Output and Standard_Error are (now) -- represented as true file variables, they need no special treatment. if token = current_input_t then if isExecutingCommand then ref.id := identifier( to_numeric( identifiers(current_input_t).value ) ); end if; getNextToken; elsif token = current_output_t then if isExecutingCommand then ref.id := identifier( to_numeric( identifiers(current_output_t).value ) ); end if; getNextToken; elsif token = current_error_t then if isExecutingCommand then ref.id := identifier( to_numeric( identifiers(current_error_t).value ) ); end if; getNextToken; else ParseInOutParameter( ref ); if ref.kind /= file_type_t and ref.kind /= socket_type_t then err( "file_type or socket_type variable expected" ); end if; end if; kind := ref.kind; -- Verify that the identifier is a file or socket. Unless during a -- syntax check, verify that the file/socket is also open (they are -- not opened during a syntax check). if not syntax_check then if length( identifiers( ref.id ).value ) = 0 then err( "file not open" ); elsif not error_found then return_ref := ref; end if; end if; end ParseOpenFileOrSocket; procedure ParseClosedFile( r : out reference ) is -- user file, must be closed (ie. value of variable not null) ref : reference; begin ref.id := eof_t; -- assume failure -- do not allow "current" or "standard" files to be closed. if token = standard_output_t then err( "file already open" ); elsif token = standard_error_t then err( "file already open" ); elsif token = current_input_t then err( "file already open" ); elsif token = current_output_t then err( "file already open" ); elsif token = current_error_t then err( "file already open" ); else ParseOutParameter( ref, file_type_t ); -- Verify that the identifier is a file. Unless during a syntax check, -- verify that the file is also open (files are not opened during a -- syntax check). if getUniType( ref.kind ) /= file_type_t then err( "expected file_type variable" ); elsif not syntax_check then if length( identifiers( ref.id ).value ) > 0 then err( "file already open" ); elsif not error_found then r := ref; end if; end if; end if; end ParseClosedFile; procedure ParseClosedSocket( f : out identifier ) is -- user file, must be closed (ie. value of variable not null) id : identifier; begin f := eof_t; -- assume failure -- do not allow "current" or "standard" files to be closed. if token = standard_output_t then err( "file already open" ); elsif token = standard_error_t then err( "file already open" ); elsif token = current_input_t then err( "file already open" ); elsif token = current_output_t then err( "file already open" ); elsif token = current_error_t then err( "file already open" ); else ParseIdentifier( id ); -- Verify that the identifier is a socket. Unless during a syntax check, -- verify that the socket is also open (sockets are not opened during a -- syntax check). if getUniType( identifiers( id ).kind ) /= socket_type_t then err( "expected socket_type variable" ); elsif not syntax_check then if length( identifiers( id ).value ) > 0 then err( "file already open" ); elsif not error_found then f := id; end if; end if; end if; end ParseClosedSocket; procedure ParseClosedFileOrSocket( return_ref : out reference; kind : out identifier ) is -- user file, must be closed (ie. value of variable not null) ref : reference; begin return_ref.id := eof_t; -- assume failure -- do not allow "current" or "standard" files to be closed. if token = standard_output_t then err( "file already open" ); elsif token = standard_error_t then err( "file already open" ); elsif token = current_input_t then err( "file already open" ); elsif token = current_output_t then err( "file already open" ); elsif token = current_error_t then err( "file already open" ); else ParseOutParameter( ref, file_type_t ); -- Verify that the identifier is a file or socket. Unless during a -- syntax check, verify that the file/socket is also open (they are -- not opened during a syntax check). kind := ref.kind; if kind /= file_type_t and kind /= socket_type_t then err( "file_type or socket_type variable expected" ); elsif not syntax_check then if length( identifiers( ref.id ).value ) > 0 then err( "file already open" ); elsif not error_found then return_ref := ref; end if; end if; end if; end ParseClosedFileOrSocket; -- "DO" procedures should be moved to parser_aux. procedure DoGet( ref : reference ) is -- Get the next character from a file or socket. Save the character -- in the ch_field field of the file record. If there is no next -- character, set the eof_field to true. The caller is assumed to -- check that the file is open. There is no eof_field check. -- -- Reasoning: UNIX/Linux has a terrible way to handle end-of-file: -- you have to read one character too many and check to see if no -- character was read. As a result, Text_IO routines must always -- be "double-buffered": they must read the character into a buffer, -- and then the application must read the character from the buffer -- to its final destination. The end-of-file cannot be checked -- without a read, and reading will cause characters to be lost if -- they are not double-buffered. But I didn't design it, did I? fd : aFileDescriptor; -- file's file descriptor ch : character; -- a buffer to read the character into eof : boolean := false; -- true if a character was read result : long_integer; -- bytes read by read fileInfo : unbounded_string; begin GetParameterValue( ref, fileInfo ); fd := aFileDescriptor'value( to_string( stringField( fileInfo, recSep, fd_field ) ) ); <> read( result, fd, ch, 1 ); if result < 0 then -- a problem? if C_errno = EAGAIN or C_errno = EINTR then goto reread; -- interrupted? try again end if; -- error? report it err( "unable to read file:" & OSerror( C_errno ) ); return; -- and bail out elsif result = 0 then -- nothing read? eof := true; -- then it's the end of file end if; if ref.id = current_output_t or -- SHOULD NEVER BE TRUE BUT... ref.id = current_input_t or ref.id = current_error_t then err( "Internal Error: DoGet was given a file alias not a real file" ); else if eof then -- eof? set eof_field replaceField( fileInfo, recSep, eof_field, "1" ); replaceField( fileInfo, recSep, line_field, -- Ada counts EOF as a line! long_integer'image( long_integer'value( to_string( stringField( fileInfo, recSep, line_field ) ) ) + 1 ) ); else -- else replace the character replace_Element( fileInfo, 1, ch ); -- save character in ch_field if ch = ASCII.LF then -- a line? increment line_field replaceField( fileInfo, recSep, line_field, long_integer'image( long_integer'value( to_string( stringField( fileInfo, recSep, line_field ) ) ) + 1 ) ); replaceField( fileInfo, recSep, eol_field, "1" ); -- and set eol_field else replaceField( fileInfo, recSep, eol_field, "0" ); -- else not end if; -- the end of the line end if; end if; AssignParameter( ref, fileInfo ); end DoGet; procedure DoInitFileVariableFields( file : identifier; fd : aFileDescriptor; name : string; mode : identifier ) is -- Create the fields in a new file variable begin -- construct the file variable's value, a series of nul delimited fields identifiers( file ).value := to_unbounded_string( "." & ASCII.NUL ); -- 1. character buffer identifiers( file ).value := identifiers( file ).value & to_unbounded_string( fd'img ) & ASCII.NUL; -- 2. file descriptor identifiers( file ).value := identifiers( file ).value & to_unbounded_string( " 0" ) & ASCII.NUL; -- 3. lines identifiers( file ).value := identifiers( file ).value & to_unbounded_string( "0" ) & ASCII.NUL; -- 4. eol flag identifiers( file ).value := identifiers( file ).value & name & ASCII.NUL; -- 5. name identifiers( file ).value := identifiers( file ).value & to_unbounded_string( mode'img ) & ASCII.NUL; -- 6. mode identifiers( file ).value := identifiers( file ).value & to_unbounded_string( "0" ) & ASCII.NUL; -- 7. eof end DoInitFileVariableFields; procedure DoFileOpen( ref : in out reference; mode : identifier; create : boolean; name : string ) is result : aFileDescriptor; flags : anOpenFlag; fileOpenRec : unbounded_string; begin if create then flags := O_CREAT; else flags := 0; end if; if mode = in_file_t then result := open( name & ASCII.NUL, flags+O_RDONLY, 8#644# ); elsif mode = out_file_t then result := open( name & ASCII.NUL, flags+O_WRONLY+O_TRUNC, 8#644# ); elsif mode = append_file_t then result := open( name & ASCII.NUL, flags+O_WRONLY+O_APPEND, 8#644# ); else err( "internal error: unexpected file mode" ); end if; if result < 0 then err( "Unable to open file: " & OSerror( C_errno ) ); elsif not error_found then -- construct the file variable's value, a series of nul delimited fields fileOpenRec := to_unbounded_string( "." & ASCII.NUL ); -- 1. character buffer fileOpenRec := fileOpenRec & to_unbounded_string( result'img ) & ASCII.NUL; -- 2. file descriptor fileOpenRec := fileOpenRec & to_unbounded_string( " 0" ) & ASCII.NUL; -- 3. lines --if mode = in_file_t then -- identifiers( file ).value := identifiers( file ).value & to_unbounded_string( -- isEOF( result )'img ) & ASCII.NUL; --else fileOpenRec := fileOpenRec & to_unbounded_string( "0" ) & ASCII.NUL; --end if; -- 4. eol flag fileOpenRec := fileOpenRec & name & ASCII.NUL; -- 5. name fileOpenRec := fileOpenRec & to_unbounded_string( mode'img ) & ASCII.NUL; -- 6. mode fileOpenRec := fileOpenRec & to_unbounded_string( "0" ) & ASCII.NUL; -- 7. eof --end if; AssignParameter( ref, fileOpenRec ); if mode = in_file_t then DoGet( ref ); -- buffer first character, set eof if none end if; if trace then put_trace( to_string( identifiers( ref.id ).name ) & " is file descriptor" & result'img ); end if; end if; end DoFileOpen; procedure DoSocketOpen( file_ref : in out reference; name : unbounded_string ) is result : aSocketFD; --flags : anOpenFlag; host : unbounded_string; port : integer; pos : natural; fileInfo : unbounded_string; begin pos := index( name, ":" ); if pos = 0 then host := name; port := 80; else begin host := to_unbounded_string( slice( name, 1, pos-1 ) ); exception when others => err( "unable to interpret TCP/IP host" ); end; begin port := integer'value( " " & slice( name, pos+1, length( name ) ) ); exception when others => err( "unable to interpret TCP/IP port" ); end; if port = 19 or port = 25 or port > 32767 then err( "access to this TCP/IP port is prohibited" ); end if; end if; if error_found then return; end if; result := openSocket( host, port ); if result < 0 then err( "Unable to socket: " & OSerror( C_errno ) ); elsif not error_found then -- construct the file variable's value, a series of nul delimited fields fileInfo := to_unbounded_string( " " & ASCII.NUL ); -- 1. character buffer fileInfo := fileInfo & to_unbounded_string( result'img ) & ASCII.NUL; -- 2. file descriptor fileInfo := fileInfo & to_unbounded_string( " 0" ) & ASCII.NUL; -- 3. lines --if mode = in_file_t then -- identifiers( file ).value := identifiers( file ).value & to_unbounded_string( -- isEOF( result )'img ) & ASCII.NUL; --else fileInfo := fileInfo & to_unbounded_string( "0" ) & ASCII.NUL; --end if; -- 4. eol flag fileInfo := fileInfo & name & ASCII.NUL; -- 5. name fileInfo := fileInfo & to_unbounded_string( "1" ) & ASCII.NUL; --end if; -- 6. doGet flag fileInfo := fileInfo & to_unbounded_string( "0" ) & ASCII.NUL; --end if; -- 7. eof AssignParameter( file_ref, fileInfo ); -- a socket cannot do an initial "DoGet" because we don't know if the user -- will be reading or writing first. DoGet could cause a hang as the server -- is waiting for an instruction and the script is waiting for a response -- from the server. As a result, we use a "DoGet" flag. If DoGet is true, -- eof_field and ch_field are not valid until an initial DoGet is done. if trace then put_trace( to_string( identifiers( file_ref.id ).name ) & " is file descriptor" & result'img ); end if; end if; end DoSocketOpen; procedure ParseOpen( create : boolean := false ) is -- Syntax: open( closed-file, mode, name ); -- Syntax: create( closed-file [,mode] [,name] ); -- Source: Ada.Text_IO.Open -- Source: Ada.Text_IO.Create file_ref : reference; mode : identifier; name : unbounded_string; kind : identifier; begin if create then if rshOpt then err( "create not allowed in a " & optional_bold( "restricted shell" ) ); end if; expect( create_t ); expect( symbol_t, "(" ); ParseClosedFile( file_ref ); kind := file_type_t; -- the mode is optional, default to out_file if token = symbol_t and identifiers( token ).value = ")" then mode := out_file_t; else expect( symbol_t, "," ); ParseIdentifier( mode ); if baseTypesOk( identifiers( mode ).kind, file_mode_t ) then if create and mode = in_file_t then err( "cannot create an in_file" ); end if; end if; end if; -- the name is optional, default to a temp file name if token = symbol_t and identifiers( token ).value = ")" then makeTempFile( name ); else expect( symbol_t, "," ); if uniTypesOk( identifiers( token ).kind, uni_string_t ) then name := identifiers( token ).value; if length( name ) = 0 and then not syntax_check then err( "pathname should not be null" ); end if; getNextToken; end if; end if; expect( symbol_t, ")" ); else expect( open_t ); expect( symbol_t, "(" ); ParseClosedFileOrSocket( file_ref, kind ); if kind = file_type_t then expect( symbol_t, "," ); ParseIdentifier( mode ); if baseTypesOk( identifiers( mode ).kind, file_mode_t ) then if boolean(rshOpt) and mode = out_file_t then err( "out_file mode not allowed in a " & optional_bold( "restricted shell" ) ); end if; end if; end if; if not error_found then -- not error_found because file must be legit in here expect( symbol_t, "," ); if kind = socket_type_t and getBaseType( identifiers( token ).kind ) = file_mode_t then err( "sockets don't have a mode" ); elsif uniTypesOk( identifiers( token ).kind, uni_string_t ) then name := identifiers( token ).value; if length( name ) = 0 and then not syntax_check then err( "pathname should not be null" ); end if; getNextToken; expect( symbol_t, ")" ); end if; end if; -- if mode and file OK end if; -- is open -- do it if isExecutingCommand then -- should use umask for permissions if kind = file_type_t then DoFileOpen( file_ref, mode, create, to_string( name ) ); else DoSocketOpen( file_ref, name ); end if; end if; end ParseOpen; procedure ParseReset is -- Syntax: reset( open-file [,mode] ) -- Source: Ada.Text_IO.Reset file_ref: reference; mode : identifier := eof_t; name : unbounded_string; modestr : unbounded_string; fd : aFileDescriptor; begin expect( reset_t ); expect( symbol_t, "(" ); ParseOpenFile( file_ref ); if token = symbol_t and identifiers( token ).value = "," then expect( symbol_t, "," ); if baseTypesOk( identifiers( token ).kind, file_mode_t ) then mode := token; getNextToken; if boolean(rshOpt) and mode = out_file_t then err( "out_file mode not allowed in a " & optional_bold( "restricted shell" ) ); end if; end if; end if; expect( symbol_t, ")" ); if isExecutingCommand then fd := aFileDescriptor'value( to_string( stringField( file_ref, fd_field ) ) ); name := stringField( file_ref, name_field ); if mode = eof_t then modestr := stringField( file_ref, mode_field ); if to_string( modestr ) = in_file_t'img then mode := in_file_t; elsif to_string( modestr ) = out_file_t'img then mode := out_file_t; elsif to_string( modestr ) = append_file_t'img then mode := append_file_t; else err( "internal error: unable to determine file mode " & to_string( modestr ) ); end if; end if; close( fd ); DoFileOpen( file_ref, mode, false, to_string( name ) ); end if; end ParseReset; procedure ParseClose is -- Syntax: close( open-file ) -- Source: Ada.Text_IO.Close file_ref : reference; fd : aFileDescriptor; kind : identifier; begin expect( close_t ); expect( symbol_t, "(" ); ParseOpenFileOrSocket( file_ref, kind ); expect( symbol_t, ")" ); if isExecutingCommand then fd := aFileDescriptor'value( to_string( stringField( file_ref, fd_field ) ) ); if fd = currentStandardInput then err( "this file is the current input file" ); elsif fd = currentStandardInput then err( "this file is the current output file" ); elsif fd = currentStandardInput then err( "this file is the current error file" ); else close( fd ); if trace then put_trace( "Closed file descriptor" & to_string( stringField( file_ref, fd_field ) ) ); end if; identifiers( file_ref.id ).value := null_unbounded_string; end if; end if; end ParseClose; procedure ParseDelete is -- Syntax: delete( open-file ) -- Source: Ada.Text_IO.Delete file_ref : reference; name : unbounded_string; fd : aFileDescriptor; result : integer; begin expect( delete_t ); expect( symbol_t, "(" ); ParseOpenFile( file_ref ); expect( symbol_t, ")" ); if rshOpt then err( "delete is not allowed in a " & optional_bold( "restricted shell" ) ); end if; if isExecutingCommand then fd := aFileDescriptor'value( to_string( stringField( file_ref, fd_field ) ) ); if fd = currentStandardInput then err( "this file is the current input file" ); elsif fd = currentStandardInput then err( "this file is the current output file" ); elsif fd = currentStandardInput then err( "this file is the current error file" ); else name := stringField( file_ref, name_field ); close( fd ); identifiers( file_ref.id ).value := null_unbounded_string; result := unlink( to_string( name ) & ASCII.NUL ); if result /= 0 then err( "unable to delete file: " & OSerror( C_errno ) ); end if; if trace then put_trace( "delete file " & to_string( name ) ); end if; end if; end if; end ParseDelete; procedure ParseSkipLine is -- Syntax: skip_line [ (open-file) ] -- Source: Ada.Text_IO.Skip_Line file_ref : reference; --fd : aFileDescriptor; ch : character; result : long_integer; kind : identifier; str : unbounded_string; begin file_ref.id := eof_t; expect( skip_line_t ); --fd := stdin; if token = symbol_t and then identifiers( Token ).value = "(" then getNextToken; ParseOpenFileOrSocket( file_ref, kind ); expect( symbol_t, ")" ); end if; if isExecutingCommand then --if file /= eof_t then -- fd := aFileDescriptor'value( to_string( stringField( file, fd_field ) ) ); --end if; --- if trace then put_trace( "Input from file descriptor" & to_string( stringField( file_ref, fd_field ) ) ); end if; if file_ref.id /= eof_t then if kind = socket_type_t and then stringField( file_ref, doget_field ) = "1" then DoGet( file_ref ); replaceField( file_ref, doget_field, "0" ); end if; loop ch := Element( identifiers( file_ref.id ).value, 1 ); if stringField(file_ref, eof_field ) = "1" then err( "end of file" ); exit; end if; DoGet( file_ref ); exit when ch = ASCII.LF or error_found; str := str & ch; end loop; else -- stdin (I don't like this) loop read( result, stdin, ch, 1 ); if result < 0 then if C_errno /= EAGAIN and C_errno /= EINTR then err( "unable to read file:" & OSerror( C_errno ) ); exit; end if; elsif result = 0 then err( "skipped past the end of the file" ); exit; else if ch = ASCII.LF then exit; end if; end if; str := str & ch; end loop; end if; if trace then Put_Trace( "Skipped '" & to_string( str ) & "'" ); end if; end if; end ParseSkipLine; procedure ParseGet is -- Syntax: get [ (open-file), ch ] -- Source: Ada.Text_IO.Get -- Note: Gnat get can't be used here because it does something -- odd with file descriptor 0 file_ref : reference; kind : identifier; fd : aFileDescriptor; ch : character; id_ref : reference; result : long_integer; fileInfo : unbounded_string; begin file_ref.id := eof_t; expect( get_t ); fd := stdin; expect( symbol_t, "(" ); if identifiers( token ).kind /= keyword_t then ParseOpenFileOrSocket( file_ref, kind ); expect( symbol_t, "," ); else file_ref.id := standard_input_t; end if; ParseOutParameter( id_ref, character_t ); if baseTypesOk( id_ref.kind, character_t ) then expect( symbol_t, ")" ); end if; if isExecutingCommand then if trace then put_trace( "Using file descriptor " & to_string( stringField( file_ref, fd_field ) ) ); end if; if file_ref.id /= eof_t then GetParameterValue( file_ref, fileInfo ); if kind = socket_type_t and then stringField( fileInfo, recSep, doget_field ) = "1" then DoGet( file_ref ); replaceField( fileInfo, recSep, doget_field, boolean'image(false)); end if; if stringField( fileInfo, recSep, eof_field ) = "1" then err( "end of file" ); else ch := Element( fileInfo, 1 ); AssignParameter( id_ref, to_unbounded_string( "" & ch ) ); AssignParameter( file_ref, fileInfo ); DoGet( file_ref ); end if; else fd := aFileDescriptor'value( to_string( stringField( file_ref, fd_field ) ) ); <> read( result, fd, ch, 1 ); if result < 0 then if C_errno = EAGAIN or C_errno = EINTR then goto reread; end if; err( "unable to read file:" & OSerror( C_errno ) ); elsif result = 0 then err( "end of file" ); else AssignParameter( id_ref, to_unbounded_string( "" & ch ) ); end if; end if; if ch = ASCII.LF then -- not stdin (or error)? replaceField( file_ref, line_field, long_integer'image( long_integer'value( to_string( stringField( file_ref, line_field ) ) ) + 1 ) ); replaceField( file_ref, eol_field, "1" ); else replaceField( file_ref, eol_field, "0" ); end if; end if; end ParseGet; procedure ParsePutLine is -- Syntax: put_line( [file,] expression ) -- Source: Ada.Text_IO.Put_Line target_ref: reference; kind : identifier := file_type_t; stderr : boolean := false; expr_val : unbounded_string; expr_type : identifier; result : long_integer; ch : character; fd : aFileDescriptor; begin target_ref.index := 0; expect( put_line_t ); expect( symbol_t, "(" ); if identifiers( token ).kind /= keyword_t then kind := getUniType( token ); if kind = file_type_t then ParseOpenFile( target_ref ); if isExecutingCommand then if to_string( stringField(target_ref, mode_field)) = in_file_t'img then err( "This is a in_mode file" ); end if; end if; expect( symbol_t, "," ); elsif kind = socket_type_t then ParseOpenSocket( target_ref ); expect( symbol_t, "," ); else target_ref.id := standard_output_t; end if; else target_ref.id := standard_output_t; end if; ParseExpression( expr_val, expr_type ); -- this sould be moved to an image function if getUniType( expr_type ) = root_enumerated_t then for i in identifiers'first..identifiers_top-1 loop if identifiers( i ).kind = expr_type then if identifiers( i ).value = expr_val then expr_val := identifiers( i ).name; exit; -- first occurrence should be original enumerated value end if; end if; end loop; end if; expect( symbol_t, ")" ); if isExecutingCommand then if target_ref.id = standard_error_t then Put_Line( standard_error, expr_val ); elsif target_ref.id = standard_output_t then Put_Line( expr_val ); last_output := expr_val; last_output_type := expr_type; else fd := aFileDescriptor'value( to_string( stringField( target_ref, fd_field ) ) ); for i in 1..length( expr_val ) loop ch := Element( expr_val, i ); <> write( result, fd, ch, 1 ); if result < 0 then if C_errno = EAGAIN or C_errno = EINTR then goto rewrite; end if; err( "unable to write: " & OSerror( C_errno ) ); exit; end if; end loop; ch := ASCII.LF; write( result, fd, ch, 1 ); -- add a line feed <> if result < 0 then if C_errno = EAGAIN or C_errno = EINTR then goto rewrite2; end if; err( "unable to write: " & OSerror( C_errno ) ); else replaceField( target_ref, line_field, long_integer'image( long_integer'value( to_string( stringField( target_ref, line_field ) ) ) + 1 ) ); end if; end if; end if; end ParsePutLine; procedure ParseQuestion is -- Syntax: "?" expression -- Source: BUSH built-in expr_val : unbounded_string; expr_type : identifier; begin expect( symbol_t ); if onlyAda95 then err( optional_bold( "pragma ada_95" ) & " doesn't allow ?" ); return; end if; ParseExpression( expr_val, expr_type ); -- this sould be moved to an image function if getUniType( expr_type ) = root_enumerated_t then for i in identifiers'first..identifiers_top-1 loop if identifiers( i ).kind = expr_type then if identifiers( i ).value = expr_val then expr_val := identifiers( i ).name; exit; -- first occurrence should be original enumerated value end if; end if; end loop; -- pretty formating for ? and time values elsif getBaseType( expr_type ) = cal_time_t then declare year : year_number; month : month_number; day : day_number; seconds : day_duration; hours : day_duration; minutes : day_duration; function get_2_digits( s : string ) return unbounded_string is tempStr : unbounded_string; dotPos : natural; begin tempStr := to_unbounded_string( s ); delete( tempStr, 1, 1 ); dotPos := index( tempStr, "." ); if dotPos > 0 then tempStr := head( tempStr, dotPos-1 ); end if; if length( tempStr ) < 2 then tempStr := "0" & tempStr; end if; return tempStr; end get_2_digits; function get_4_digits( s : string ) return unbounded_string is tempStr : unbounded_string; dotPos : natural; begin tempStr := to_unbounded_string( s ); delete( tempStr, 1, 1 ); dotPos := index( tempStr, "." ); if dotPos > 0 then tempStr := head( tempStr, dotPos-1 ); end if; if length( tempStr ) < 4 then tempStr := "0" & tempStr; end if; return tempStr; end get_4_digits; function drop_leading_space( s : string ) return unbounded_string is tempStr : unbounded_string; begin tempStr := to_unbounded_string( s ); delete( tempStr, 1, 1 ); return tempStr; end drop_leading_space; begin Split( time( to_numeric( expr_val ) ), year, month, day, seconds ); hours := duration( float'truncation( float( seconds / (60 * 60) ) ) ); seconds := seconds - hours * (60* 60); minutes := duration( float'truncation( float( seconds / ( 60 ) ) ) ); seconds := seconds - (minutes * 60); expr_val := get_4_digits( year'img ) & "/"; expr_val := expr_val & get_2_digits( month'img ) & "/"; expr_val := expr_val & get_2_digits( day'img ) & " "; expr_val := expr_val & get_2_digits( hours'img ) & ":"; expr_val := expr_val & get_2_digits( minutes'img ) & ":"; expr_val := expr_val & drop_leading_space( seconds'img ); end; end if; if isExecutingCommand then -- fix this for no output on error! Put_Line( expr_val ); last_output := expr_val; last_output_type := expr_type; replaceField( standard_output_t, line_field, long_integer'image( long_integer'value( to_string( stringField( standard_output_t, line_field ) ) ) + 1 ) ); end if; end ParseQuestion; procedure ParsePut is -- Syntax: put( [open-file,] expression [, picture] ) -- Source: Ada.Text_IO.Editing.Put target_ref: reference; kind : identifier; stderr : boolean := false; expr_val : unbounded_string; expr_type : identifier; result : long_integer; ch : character; fd : aFileDescriptor; pic : Picture; pic_val : unbounded_string; pic_type : identifier; begin expect( put_t ); expect( symbol_t, "(" ); if identifiers( token ).kind /= keyword_t then kind := getUniType( token ); if kind = file_type_t then ParseOpenFile( target_ref ); if isExecutingCommand then if to_string( stringField(target_ref, mode_field)) = in_file_t'img then err( "This is a in_mode file" ); end if; end if; expect( symbol_t, "," ); elsif kind = socket_type_t then ParseOpenSocket( target_ref ); expect( symbol_t, "," ); else target_ref.id := standard_output_t; end if; else target_ref.id := standard_output_t; end if; ParseExpression( expr_val, expr_type ); -- this sould be moved to an image function if getUniType( expr_type ) = root_enumerated_t then for i in identifiers'first..identifiers_top-1 loop if identifiers( i ).kind = expr_type then if identifiers( i ).value = expr_val then expr_val := identifiers( i ).name; exit; -- first occurrence should be original enumerated value end if; end if; end loop; end if; -- apply optional numeric formatting if token = symbol_t and identifiers( token ).value = "," then expect( symbol_t, "," ); ParseExpression( pic_val, pic_type ); if getUniType( pic_type ) /= uni_string_t then err( "number format picture string expected" ); elsif not valid( to_string( pic_val ) ) then err( "number not a valid format picture" ); elsif getUniType( expr_type ) /= uni_numeric_t then err( "only numeric types can use a format picture" ); else if isExecutingCommand then pic := to_picture( to_string( pic_val ) ); expr_val := to_unbounded_string( image( decimal_output_type( to_numeric( expr_val ) ), pic ) ); end if; last_output_type := uni_string_t; end if; else last_output_type := expr_type; end if; expect( symbol_t, ")" ); if isExecutingCommand then if target_ref.id = standard_error_t then Put( standard_error, expr_val ); elsif target_ref.id = standard_output_t then Put( expr_val ); last_output := expr_val; else fd := aFileDescriptor'value( to_string( stringField( target_ref, fd_field ) ) ); for i in 1..length( expr_val ) loop ch := Element( expr_val, i ); write( result, fd, ch, 1 ); <> if result < 0 then if C_errno = EAGAIN or C_errno = EINTR then goto rewrite; end if; err( "unable to write: " & OSerror( C_errno ) ); exit; end if; end loop; end if; end if; end ParsePut; procedure ParseNewLine is -- Syntax: new_line -- Source: Ada.Text_IO.New_Line target_ref : reference; kind : identifier; fd : aFileDescriptor; -- Linux file descriptor of output file ch : character; result : long_integer; begin expect( new_line_t ); if token = symbol_t and identifiers( token ).value = "(" then expect( symbol_t, "(" ); ParseOpenFileOrSocket( target_ref, kind ); expect( symbol_t, ")" ); else target_ref.id := standard_output_t; end if; if isExecutingCommand then if target_ref.id = standard_error_t then New_Line( standard_error ); elsif target_ref.id = standard_output_t then New_Line; else fd := aFileDescriptor'value( to_string( stringField( target_ref, fd_field ) ) ); ch := ASCII.LF; <> write( result, fd, ch, 1 ); if result < 0 then if C_errno = EAGAIN or C_errno = EINTR then goto rewrite; end if; err( "unable to write: " & OSerror( C_errno ) ); end if; end if; end if; end ParseNewLine; procedure ParseSetInput is -- Syntax: set_input( open-file ) -- Source: Ada.Text_IO.Set_Input file_ref: reference; -- open file to assign output to fd : aFileDescriptor; -- Linux file descriptor of output file result : aFileDescriptor := 0; -- result of dup2 begin expect( set_input_t ); expect( symbol_t, "(" ); ParseOpenFile( file_ref ); if file_ref.id = standard_output_t then err( optional_bold( "standard_output" ) & " cannot be assigned for " & optional_bold( "input" ) ); elsif file_ref.id = standard_error_t then err( optional_bold( "standard_error" ) & " cannot be assigned for " & optional_bold( "input" ) ); elsif not syntax_check then if to_string(stringField(file_ref, mode_field)) /= in_file_t'img then err( "not an in_file file" ); end if; end if; expect( symbol_t, ")" ); if isExecutingCommand then fd := aFileDescriptor'value( to_string( stringField( file_ref, fd_field ) ) ); result := dup2( fd, stdin ); if result < 0 then err( "unable to set input: " & OSerror( C_errno ) ); elsif not error_found then currentStandardInput := fd; identifiers( current_input_t ).value := to_unbounded_string( file_ref.id'img ); if trace then put_trace( "input is currently from file descriptor" & currentStandardInput'img ); end if; end if; end if; end ParseSetInput; procedure ParseSetOutput is -- Syntax: set_output( open-file ) -- Source: Ada.Text_IO.Set_Output file_ref : reference; -- open file to assign output to fd : aFileDescriptor; -- Linux file descriptor of output file result : aFileDescriptor := 0; -- result of dup2 begin expect( set_output_t ); expect( symbol_t, "(" ); ParseOpenFile( file_ref ); if file_ref.id = standard_input_t then err( optional_bold( "standard_input" ) & " cannot be assigned for " & optional_bold( "output" ) ); elsif not syntax_check then if to_string(stringField(file_ref.id, mode_field)) = in_file_t'img then err( "not an out_file or append_file file" ); end if; end if; expect( symbol_t, ")" ); if isExecutingCommand then fd := aFileDescriptor'value( to_string( stringField( file_ref.id, fd_field ) ) ); result := dup2( fd, stdout ); if result < 0 then err( "unable to set output: " & OSerror( C_errno ) ); elsif not error_found then currentStandardOutput := fd; identifiers( current_output_t ).value := to_unbounded_string( file_ref.id'img ); if trace then put_trace( "output is currently to file descriptor" & currentStandardOutput'img ); end if; end if; end if; end ParseSetOutput; procedure ParseSetError is -- Syntax: set_error( open-file ) -- Source: Ada.Text_IO.Set_Error file_ref:reference; result : aFileDescriptor := 0; fd : aFileDescriptor; begin expect( set_error_t ); expect( symbol_t, "(" ); ParseOpenFile( file_ref ); if file_ref.id = standard_input_t then err( optional_bold( "standard_input" ) & " cannot be assigned for " & optional_bold( " standard error" ) ); elsif not syntax_check then if to_string(stringField(file_ref, mode_field)) = in_file_t'img then err( "not an out_file or append_file file" ); end if; end if; expect( symbol_t, ")" ); if isExecutingCommand then fd := aFileDescriptor'value( to_string( stringField( file_ref, fd_field ) ) ); result := dup2( fd, stderr ); if result < 0 then err( "unable to set error: " & OSerror( C_errno ) ); elsif not error_found then currentStandardError := fd; identifiers( current_error_t ).value := to_unbounded_string( file_ref.id'img ); if trace then put_trace( "error output is currently to file descriptor" & currentStandardError'img ); end if; end if; end if; end ParseSetError; procedure StartupTextIO is begin -- Predefined Text_IO Types declareStandardConstant( in_file_t, "in_file", file_mode_t, "0" ); declareStandardConstant( out_file_t, "out_file", file_mode_t, "1" ); declareStandardConstant( append_file_t, "append_file", file_mode_t, "2" ); -- Text I/O Identifiers declareProcedure( create_t, "create" ); declareProcedure( open_t, "open" ); declareProcedure( close_t, "close" ); declareProcedure( get_t, "get" ); declareFunction( get_line_t, "get_line" ); declareFunction( inkey_t, "inkey" ); declareProcedure( put_t, "put" ); declareProcedure( put_line_t, "put_line" ); declareProcedure( new_line_t, "new_line" ); declareFunction( is_open_t, "is_open" ); declareFunction( end_of_file_t, "end_of_file" ); declareFunction( end_of_line_t, "end_of_line" ); declareFunction( name_t, "name" ); declareFunction( mode_t, "mode" ); declareProcedure( skip_line_t, "skip_line" ); declareFunction( line_t, "line" ); declareProcedure( set_input_t, "set_input" ); declareProcedure( set_output_t, "set_output" ); declareProcedure( set_error_t, "set_error" ); declareProcedure( reset_t, "reset" ); -- declareProcedure( delete_t, "delete" ); -- delete declared in scanner since it's also a SQL command -- Other Text I/O Constants declareStandardConstant( standard_input_t, "standard_input", file_type_t, "" ); declareStandardConstant( standard_output_t, "standard_output", file_type_t, "" ); declareStandardConstant( standard_error_t, "standard_error", file_type_t, "" ); -- these should not be constants, but we don't have a function type yet declareStandardConstant( current_input_t, "current_input", file_type_t, "" ); declareStandardConstant( current_output_t, "current_output", file_type_t, "" ); declareStandardConstant( current_error_t, "current_error", file_type_t, "" ); end StartupTextIO; procedure ShutdownTextIO is begin null; end ShutdownTextIO; end parser_tio;