----------------------------------------------------------------------------- -- -- Onions Network Streams Library -- -- O N I O N S . I N S T R E A M S . D I R -- -- 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 and Yuzo Kanomata ----------------------------------------------------------------------------- -- -- The Dir Input Stream is a stream end that reads a filesystem directory -- and generates a stream of filename buckets. Open must be called -- before reading. A filter can be used on top of this stream to -- create a formatted directory listing. -- with Ada.Streams; use Ada.Streams; with System.Storage_Elements; with Interfaces.C.Strings; 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.Instreams.Dir is use Bucket_Queues; use type C.int; use type System.Address; --------------------------------------------- -- Dispatching Stream Control Operations -- --------------------------------------------- procedure Dispose is new Unchecked_Deallocation (Dir_Input_Stream, Dir_Input_Stream_Ptr); -- Free the storage associated with a stream object. -- procedure Free (SP : in out Dir_Input_Stream_Ptr) is begin if SP /= null then if SP.DIR_Ptr /= System.Null_Address then Close (SP.all); end if; Dispose (SP); end if; end Free; -- Open the named directory and associate it with an input stream. -- Raises Device_Error if it is unable to open the directory. -- function Open (Stream : in Dir_Input_Stream_Ptr; Name : in String) return Input_Pipe is begin if Stream.DIR_Ptr /= System.Null_Address then Close (Stream.all); end if; Stream.Dirname := C.Strings.New_String (Name); loop Stream.DIR_Ptr := C_opendir (Stream.Dirname); exit when Stream.DIR_Ptr /= System.Null_Address; if C_errno /= EINTR then Stream.System_Error := C_errno; C.Strings.Free (Stream.Dirname); Raise_Error (Device_Error'Identity, Stream.System_Error, "Unable to open directory " & Name); end if; end loop; Stream.Byte_Count := 0; Stream.Timeout := 0; Stream.System_Error := 0; return Input_Pipe (Stream); end Open; -- Close the directory associated with the stream. Note that this -- is different from a Close of an Input_Pipe in that it does not -- free the stream. I.e., the stream can be Open'd again. -- procedure Close (Stream : in out Dir_Input_Stream) is ItemList : Bucket_List; Status : C.int; begin if Stream.DIR_Ptr /= System.Null_Address then if Length (Stream.Processed) > 0 then Dequeue (Stream.Processed, ItemList); Free (ItemList); end if; loop Status := C_closedir (Stream.DIR_Ptr); 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; Stream.DIR_Ptr := System.Null_Address; C.Strings.Free (Stream.Dirname); 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 Dir_Input_Stream) is begin Close (Stream); end Abort_Stream; -- Reset is like Close, but only resets to the directory beginning -- instead of closing the directory. -- procedure Reset (Stream : in out Dir_Input_Stream) is ItemList : Bucket_List; begin if Length (Stream.Processed) > 0 then Dequeue (Stream.Processed, ItemList); Free (ItemList); end if; Stream.Byte_Count := 0; Stream.Timeout := 0; Stream.System_Error := 0; if Stream.DIR_Ptr /= System.Null_Address then C_rewinddir (Stream.DIR_Ptr); end if; end Reset; -- Drain the stream by returning any processed data -- as if it were the end-of-stream. -- procedure Drain (Stream : in out Dir_Input_Stream; ItemList : out Bucket_List) is begin if Length (Stream.Processed) > 0 then Dequeue (Stream.Processed, ItemList); else ItemList := null; end if; end Drain; -- Name returns a string containing the currently open directory name. -- function Name (Stream : in Dir_Input_Stream) return String is use C.Strings; begin if Stream.Dirname = Null_Ptr then return ""; else return Value (Stream.Dirname); end if; end Name; ------------------------------------ -- Ada.Streams Dispatching Read -- ------------------------------------ -- Read obtains stream a filename from Stream and places it into -- the components of Item. Last is set to the index of -- the last component of Item that was filled. 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 Read (Stream : in out Dir_Input_Stream; Item : out Stream_Element_Array; Last : out Stream_Element_Offset) is ReadList : Bucket_List; begin Last := Item'First - 1; while Length (Stream.Processed) = 0 loop Process (Stream, False); end loop; Dequeue (Stream.Processed, ReadList); Dump_Into (ReadList, Item, Last); if not IsEmpty (ReadList) then Undequeue (Stream.Processed, ReadList); end if; exception when End_Error => if Last < Item'First then raise End_Error; end if; end Read; ---------------------------------- -- Data Processing Operations -- ---------------------------------- use System.Storage_Elements; -- Process does the real work of reading from the directory and moving -- each filename bucket to the Processed read queue. -- The Everything (end-of-stream indicator) boolean is ignored. -- Raises End_Error when end-of-directory is encountered; -- Status_Error if the directory hasn't been Open'd yet; -- Storage_Error if there is no memory available for the buffer; -- Device_Error if anything else goes fatally wrong. -- procedure Process (Stream : in out Dir_Input_Stream; Everything : Boolean) is Bucko : Bucket; Flen : Storage_Offset; begin if Stream.DIR_Ptr = System.Null_Address then Raise_Error (Status_Error'Identity, 0, "Directory stream must be opened before Read"); end if; -- Allocate enough space for the longest filename -- Bucko := Allocate (NAME_MAX + 1); -- Read the next filename from the directory ("." and ".." excluded) -- Flen := OS.Readdir (Stream.DIR_Ptr, Address_Of (Bucko), NAME_MAX + 1); if Flen > 0 then Stream.Byte_Count := Stream.Byte_Count + Flen; Truncate (Bucko, Flen); Enqueue (Stream.Processed, Bucko); elsif Flen = 0 then Free (Bucko); raise End_Error; else Stream.System_Error := C_errno; Free (Bucko); Raise_Error (Device_Error'Identity, Stream.System_Error, "Unable to read directory " & C.Strings.Value (Stream.Dirname)); end if; end Process; -- Unprocess would be called by Pop if someone foolishly tried -- to pop off the Dir_Input_Stream. We don't allow that. -- procedure Unprocess (Stream : in out Dir_Input_Stream) is begin raise Use_Error; end Unprocess; end Onions.Instreams.Dir;