----------------------------------------------------------------------------- -- -- Onions Network Streams Library -- -- O N I O N S . O U T S T R E A M S . F I L E -- -- B o d y -- -- Copyright (C) 1997-1998 Regents of the University of California -- -- Onions is free software; you can redistribute it and/or modify it under -- the terms of the GNU General Public License as published by the Free -- Software Foundation, with or without the single exception listed below; -- either version 2, or (at your option) any later version. Onions is -- distributed in the hope that it will be useful, but WITHOUT 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 Onions; see the file COPYING. If not, write to the -- Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA -- 02111-1307, USA. -- -- As a special exception, if other files instantiate generics from this -- library, or you link this library with other files to produce an -- executable, this library does not by itself cause the resulting -- executable to be covered by the GNU General Public License. This -- exception does not however invalidate any other reasons why the -- executable file might be covered by the GNU General Public License. -- -- Created in 1997 by Roy T. Fielding ----------------------------------------------------------------------------- -- -- The File Output Stream is a stream end that performs buffered writes -- on a filesystem descriptor. -- -- I'd be interested to see a performance comparison of this package -- versus Ada.Text_IO input files. -- with Ada.Streams; with Interfaces.C; with System.Storage_Elements; with Onions.Buckets; use Onions.Buckets; with Onions.Constants; use Onions.Constants; with Onions.Thin; use Onions.Thin; with Onions.OS; use Onions.OS; with Unchecked_Deallocation; package body Onions.Outstreams.File is use Bucket_Queues; use type C.int; --------------------------------------------- -- Dispatching Stream Control Operations -- --------------------------------------------- procedure Dispose is new Unchecked_Deallocation (File_Output_Stream, File_Output_Stream_Ptr); -- Free the storage associated with a stream object. -- procedure Free (SP : in out File_Output_Stream_Ptr) is ItemList : Bucket_List; begin if SP /= null then if Length (SP.Unprocessed) > 0 then Dequeue (SP.Unprocessed, ItemList); Free (ItemList); end if; if SP.Fd /= Failure then Close (SP.all); end if; Dispose (SP); end if; end Free; -- Bind an already open descriptor to the stream. -- function Bind (Stream : in File_Output_Stream_Ptr; Filedes : in Descriptor) return Output_Pipe is begin Stream.Fd := Filedes; Stream.Filename := C.Strings.New_String (C.int'Image (Filedes)); Stream.Byte_Count := 0; Stream.Timeout := 0; if Set_Non_Blocking (Stream.Fd) = Failure then Stream.System_Error := C_errno; else Stream.System_Error := 0; end if; return Output_Pipe (Stream); end Bind; -- Open the descriptor associated with a stream. If Name is "", the -- stream is associated with the already open STDOUT descriptor, -- otherwise the named file is opened for writing. Raises Device_Error -- if it is unable to open a descriptor for the named file. -- function Open (Stream : in File_Output_Stream_Ptr; Mode : in Output_Mode := Stdout; Perms : in mode_t := 0; Name : in String := "") return Output_Pipe is use C.Strings; Flags : Int_Flags; begin if Stream.Fd /= Failure then Close (Stream.all); end if; case Mode is when Stdout => Stream.Fd := STDOUT_FILENO; Stream.Filename := New_String ("stdout"); when Stderr => Stream.Fd := STDERR_FILENO; Stream.Filename := New_String ("stderr"); Stream.Threshold_Buckets := 0; when Append => Flags := O_WRONLY or O_CREAT or O_APPEND or O_BINARY; when Create => Flags := O_WRONLY or O_CREAT or O_TRUNC or O_BINARY; when Existing => Flags := O_WRONLY or O_TRUNC or O_BINARY; when Exclusive => Flags := O_WRONLY or O_CREAT or O_EXCL or O_BINARY; end case; if Mode /= Stdout and Mode /= Stderr then if Name = "" then if Stream.Filename = Null_Ptr then raise Name_Error; end if; else if Stream.Filename /= Null_Ptr then Free (Stream.Filename); end if; Stream.Filename := New_String (Name); end if; loop Stream.Fd := C_open (Stream.Filename, Flags, Perms); if Stream.Fd = Failure then Stream.System_Error := C_errno; case Stream.System_Error is when EINTR => Stream.System_Error := 0; when EACCES | EROFS | EISDIR => Raise_Error (Use_Error'Identity, Stream.System_Error, "Unable to open file " & Name); when EEXIST | EFAULT | ENOENT | ENAMETOOLONG | ENOTDIR => Raise_Error (Name_Error'Identity, Stream.System_Error, "Unable to open file " & Name); when others => Raise_Error (Device_Error'Identity, Stream.System_Error, "Unable to open file " & Name); end case; else exit; end if; end loop; end if; Stream.Byte_Count := 0; Stream.Timeout := 0; if Set_Non_Blocking (Stream.Fd) = Failure then Stream.System_Error := C_errno; else Stream.System_Error := 0; end if; return Output_Pipe (Stream); end Open; -- Close the descriptor associated with a stream. Note that this -- is different from a Close of an Output_Pipe in that it does not -- free the stream. I.e., the stream can be Open'd again. -- procedure Close (Stream : in out File_Output_Stream) is ItemList : Bucket_List; Status : C.int; begin if Stream.Fd /= Failure then Flush (Stream); if Stream.Fd /= STDOUT_FILENO and Stream.Fd /= STDERR_FILENO then loop Status := C_close (Stream.Fd); if Status < 0 then Stream.System_Error := C_errno; exit when Stream.System_Error /= EINTR; else Stream.System_Error := 0; exit; end if; end loop; end if; Stream.Fd := Failure; C.Strings.Free (Stream.Filename); end if; end Close; -- Abort_Stream should only be used if a stream is interrupted -- by the user, or an error occurs that makes the whole stream bad. -- It forces the stream closed without a flush. -- procedure Abort_Stream (Stream : in out File_Output_Stream) is ItemList : Bucket_List; begin if Length (Stream.Unprocessed) > 0 then Dequeue (Stream.Unprocessed, ItemList); Free (ItemList); end if; Close (Stream); end Abort_Stream; -- Reset is like Close, but resets the stream to the state -- it would be in if it was just created. It flushes -- anything in its own buffers. -- procedure Reset (Stream : in out File_Output_Stream) is Dummy : off_t; begin Flush (Stream); Stream.Byte_Count := 0; Stream.Timeout := 0; Stream.System_Error := 0; if Stream.Fd /= Failure and Stream.Fd /= STDOUT_FILENO and Stream.Fd /= STDERR_FILENO then Dummy := C_lseek (Stream.Fd, 0, SEEK_SET); end if; end Reset; -- The Flush method tells the stream to send any outbound buffered data -- downstream, but without taking down the stream. The stream decides -- whether or not it has buffered data to write. -- procedure Flush (Stream : in out File_Output_Stream) is begin Process (Stream, True); end Flush; -- Get a file stream's write buffer size for max blocks. -- function Get_Max_Buffer_Blocksize (Stream : in File_Output_Stream) return Natural is begin return Stream.Threshold_Buckets; end Get_Max_Buffer_Blocksize; -- Set a file stream's write buffer size for max blocks. -- A Num_Blocks of 0 will set it to unbuffered. -- procedure Set_Max_Buffer_Blocksize (Stream : in out File_Output_Stream; Num_Blocks : in Natural) is begin Stream.Threshold_Buckets := Num_Blocks; end Set_Max_Buffer_Blocksize; -- Name returns a string containing the currently open file name. -- function Name (Stream : in File_Output_Stream) return String is use C.Strings; begin if Stream.Filename = Null_Ptr then return ""; else return Value (Stream.Filename); end if; end Name; ------------------------------------- -- Ada.Streams Dispatching Write -- ------------------------------------- -- Write places each of the elements of Item into Stream in order. This -- interface is defined by Ada.Streams for abstract stream operations. -- We won't use it much because it forces a full data copy when filtering. -- procedure Write (Stream : in out File_Output_Stream; Item : in Ada.Streams.Stream_Element_Array) is begin Enqueue (Stream.Unprocessed, New_Bucket (Item)); Process (Stream, False); end Write; ---------------------------------- -- Data Processing Operations -- ---------------------------------- use System.Storage_Elements; -- Process does the magic necessary to move the data from then -- Unprocessed write queue to the File. If Everything, then process -- the entire Unprocessed buffer as if it were the end-of-stream. -- Raises Timeout_Exceeded if we have to wait longer than Stream.Timeout; -- Device_Error if anything else goes fatally wrong. -- procedure Process (Stream : in out File_Output_Stream; Everything : Boolean) is Buffer_List : Bucket_List; Buffer_Num : Natural; Buffer_Bytes : Storage_Offset; begin if Length (Stream.Unprocessed) > 0 then Dequeue (Stream.Unprocessed, Buffer_List); Get_Size (Buffer_List, Buffer_Num, Buffer_Bytes); if Stream.Fd = Failure then Free (Buffer_List); Raise_Error (Status_Error'Identity, 0, "File stream must be opened before Write"); elsif Buffer_Bytes > 0 then if not Everything and Buffer_Bytes < Stream.Threshold_Bytes and Buffer_Num < Stream.Threshold_Buckets then Enqueue (Stream.Unprocessed, Buffer_List); return; end if; begin Write_Vector (Stream.Fd, Stream.Timeout, Buffer_List, Buffer_Num, Buffer_Bytes); exception when Device_Error => Stream.System_Error := C_errno; Free (Buffer_List); Raise_Error (Device_Error'Identity, Stream.System_Error, "Unable to write to file " & C.Strings.Value (Stream.Filename)); when others => Free (Buffer_List); raise; end; Stream.Byte_Count := Stream.Byte_Count + Buffer_Bytes; end if; Free (Buffer_List); end if; end Process; end Onions.Outstreams.File;