DataMuseum.dk

Presents historical artifacts from the history of:

Rational R1000/400

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about Rational R1000/400

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - download

⟦2a013b787⟧ Ada Source

    Length: 86016 (0x15000)
    Types: Ada Source
    Notes: 03_class, FILE, Long Ada Source, R1k_Segment, e3_tag, procedure Ship_To_Unix, seg_005815

Derivation

└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
    └─ ⟦5a81ac88f⟧ »Space Info Vol 1« 
        └─⟦this⟧ 

E3 Source Code



with Archive;
with Byte_Defs;
with Common;
with Compilation;
with Debug_Tools;
with Directory_Tools;
with Editor;
with File_Transfer;
with Ftp_Defs;
with Ftp_Profile;
with Text_Io;
with Time_Utilities;
with Library;
with Log;
with Profile;
with String_Map_Generic;
with String_Utilities;
with System_Utilities;
with Table_Sort_Generic;
with Transport;
with Transport_Defs;
with Transport_Name;
with Unchecked_Deallocation;

procedure Ship_To_Unix  
             (Password     : String;            -- User's password
              Force_Update : Boolean := False;  -- Update regardless
              Effort_Only  : Boolean := False;  -- Just checking
              Unix_Machine : String  := "<SHIP_TO_MACHINE>";
              Username     : String  := "<SHIP_TO_USERNAME>") is
------------------------------------------------------------------------------
-- Copyright 1990 - 1991 by Rational, Santa Clara, California.
--
--                  All Rights Reserved.
--
-- Permission to use, copy, modify, and distribute this software and its
-- documentation for any purpose and without fee is hereby granted,
-- provided that the above copyright notice(s) appear in all copies and that
-- both that copyright notice(s) and this permission notice appear in
-- supporting documentation, and that the names of Rational not be used in
-- advertising or publicity pertaining to distribution of the software without
-- specific, written prior permission.
--
-- Rational disclaims all warranties with regard to this software, including
-- all implied warranties of merchantability and fitness, in no event shall
-- Rational be liable for any special, indirect or consequential damages or
-- any damages whatsoever resulting from loss of use, data or profits, whether
-- in an action of contract, negligence or other tortious action, arising out
-- of or in connection with the use or performance of this software.
------------------------------------------------------------------------------

------------------------------------------------------------------------------
-- Imported Renames
------------------------------------------------------------------------------

    package Dt renames Directory_Tools;

    function "=" (A, B : Dt.Object.Class_Enumeration) return Boolean
        renames Dt.Object."=";
    function "=" (A, B : Ftp_Defs.Status_Code)        return Boolean
        renames Ftp_Defs."=";
    function "=" (A, B : Transport_Defs.Status_Code)  return Boolean
        renames Transport_Defs."=";

------------------------------------------------------------------------------
-- Exceptions
------------------------------------------------------------------------------

    I_Am_Confused : exception;
    ----I give up.  Some assumption of the code has changed and the code wasn't
    --  changed to reflect it.

    Quit : exception;
    ----Raised when we want to give up on something.
------------------------------------------------------------------------------
-- Types
------------------------------------------------------------------------------

    type String_Pointer is access String;

    pragma Enable_Deallocation (String_Pointer);

    procedure Free_String_Pointer is  
       new Unchecked_Deallocation (String,  
                                   String_Pointer);

    type Natural_Array is array (Natural range <>) of Natural;

    type Database_Entry_Rec is
        record
            ----These are used only during processing.
            --  They are not saved in the database.

            Full_R1000_Name : String_Pointer := null;
            Update          : Boolean        := False;
            Bad_Name        : Boolean        := False;
            Updated         : Boolean        := False;

            ----These are saved in the database.

            R1000_Name : String_Pointer;    -- Object minus 'V(nn)
            Unix_Path  : String_Pointer;    -- Path on unix
            Unix_Name  : String_Pointer;    -- Name of file on Unix
            Version    : String_Pointer;    -- 'V(nn) or 'V(library)
            Directory  : Boolean;           -- True for libraries/worlds
            Ignore     : Boolean := False;  -- True for R1000-only files
            New_One    : Boolean := False;  -- True for new objects
        end record;

    type Database_Entry is access Database_Entry_Rec;

    pragma Enable_Deallocation (Database_Entry);

    procedure Free_Database_Entry is  
       new Unchecked_Deallocation (Database_Entry_Rec,  
                                   Database_Entry);

    type Database_Entry_Array is array (Natural range <>) of Database_Entry;

    function Check_Object (Obj  : Dt.Object.Handle;  
                           Root : String) return Database_Entry;

------------------------------------------------------------------------------
-- Global Data
------------------------------------------------------------------------------

    package Obj_Db is  
       new String_Map_Generic (Range_Type  => Database_Entry,  
                               Size        => 401,  
                               Ignore_Case => True);

    Database : Obj_Db.Map;

    Connection : File_Transfer.Connect_Id;

    Host_Machine_Name : String_Pointer;
    Host_User_Name    : String_Pointer;

    Files_Processed   : Integer := 0;
    Files_Transferred : Integer := 0;
    Files_Deferred    : Integer := 0;

    Temp_File_Used : Boolean         := False;
    Temp_File_Name : constant String :=
       "!Machine.Temporary.Ship_To_Unix_" &
          Time_Utilities.Image (Time_Utilities.Get_Time,
                                Date_Style => Time_Utilities.Ada,
                                Contents   => Time_Utilities.Date_Only) & "_" &
          Time_Utilities.Image (Time_Utilities.Get_Time,
                                Time_Style => Time_Utilities.Ada,
                                Contents   => Time_Utilities.Time_Only);

--\x0c
    function X_Env_Get_Environment_Variable
                (Var : String) return String_Pointer is
------------------------------------------------------------------------------
--  Var     - Specifies the name of the variable
--
-- Returns None_X_String_Pointer if the variable does not exist or if
-- this environment/operating-system/run-time does not support any such
-- concept as environment variables.
--
-- Don't forget to free the string result with Free_X_String_Pointer;
------------------------------------------------------------------------------
--/ if R1000 then

        Env      : Text_Io.File_Type;
        Env_Name : constant String :=  
           System_Utilities.Home_Library (User => System_Utilities.User_Name)  
               & "."  
               & System_Utilities.Session_Name & "_Environment."  
               & Var;
        Env_Ptr  : String_Pointer;

        function Read_Env return String is
            ----Read one line from Env; regardless of the length of the
            --  line.
            Line   : String (1 .. 1024);
            Length : Natural;
        begin
            Text_Io.Get_Line (Env, Line, Length);
            if Length = Line'Length and then  
               Text_Io.">" (Text_Io.Col (Env), 1) then
                return Line & Read_Env;
            else
                return Line (1 .. Length);
            end if;
        end Read_Env;

    begin

----Open the Environment Variable file.  Read the first line.  Close the file.
--  Return that line as the value.

        begin
            Text_Io.Open (Env, Text_Io.In_File, Env_Name);
            Env_Ptr := new String'(Read_Env);
            Text_Io.Close (Env);
            return Env_Ptr;
        exception
            when others =>
                begin                               -- Just in case.
                    Free_String_Pointer (Env_Ptr);
                    Text_Io.Close (Env);  
                exception
                    when others =>
                        null;
                end;
                return null;
        end;

--/ else
--//
--//    begin
--//
--//         begin
--//             return new X_String'(To_X_String (Ui_Environment.Getenv (Var)));
--//         exception
--//             when Constraint_Error =>
--//                 ----Getenv raises this when the variable does not exist.
--//                 return None_X_String_Pointer;
--//         end;
--//
--/ end if;

    end X_Env_Get_Environment_Variable;

--\x0c
    function Hs (Str : String) return String_Pointer is
------------------------------------------------------------------------------
--  Str - Specifies the string value
--
-- Called to allocate a string on the heap.
------------------------------------------------------------------------------
        Tmp : String (1 .. Str'Length) := Str;
    begin
        return new String'(Tmp);
    end Hs;

--\x0c
    procedure Read_Database (Name : String) is
------------------------------------------------------------------------------
--  Name    - Speicifies the name of the database to read
--
--  Called to read in an Ascii database file.
------------------------------------------------------------------------------
        Line  : String (1 .. 1024);
        Len   : Natural;
        File  : Text_Io.File_Type;
        Ent   : Database_Entry;
        Error : Boolean := False;
    begin

----Open the file.

        begin
            Text_Io.Open (File, Text_Io.In_File, Name);
        exception
            when others =>
                Log.Put_Line ("Error opening " & Name & "; exception " &
                              Debug_Tools.Get_Exception_Name (True, True),  
                              Profile.Exception_Msg,  
                              Profile.Verbose);
                raise Quit;
        end;

----Read the file.

        while not Text_Io.End_Of_File (File) loop
            Ent := new Database_Entry_Rec;

            Text_Io.Get_Line (File, Line, Len);
            if Len = 0 or else Line (1) = '=' then
                raise I_Am_Confused;
            end if;
            Ent.R1000_Name := Hs (Line (1 .. Len));

            Text_Io.Get_Line (File, Line, Len);
            if Len > 0 and then Line (1) = '=' then
                raise I_Am_Confused;
            end if;
            Ent.Unix_Path := Hs (Line (1 .. Len));

            Text_Io.Get_Line (File, Line, Len);
            if Len = 0 or else Line (1) = '=' then
                raise I_Am_Confused;
            end if;
            Ent.Unix_Name := Hs (Line (1 .. Len));
            Text_Io.Get_Line (File, Line, Len);
            if Len > 0 and then Line (1) = '=' then
                raise I_Am_Confused;
            end if;
            Ent.Version := Hs (Line (1 .. Len));

            Text_Io.Get_Line (File, Line, Len);
            if Len = 0 or else Line (1) = '=' then
                raise I_Am_Confused;
            end if;
            if String_Utilities.Equal ("directory:",  
                                       Line (1 .. 10),  
                                       Ignore_Case => True) then
                Ent.Directory := Boolean'Value (Line (11 .. Len));
            else
                raise I_Am_Confused;
            end if;

            Text_Io.Get_Line (File, Line, Len);
            if Len = 0 or else Line (1) = '=' then
                raise I_Am_Confused;
            end if;
            if String_Utilities.Equal ("ignore:",  
                                       Line (1 .. 7),  
                                       Ignore_Case => True) then
                Ent.Ignore := Boolean'Value (Line (8 .. Len));
            else
                raise I_Am_Confused;
            end if;

            Text_Io.Get_Line (File, Line, Len);
            if Len = 0 or else Line (1) = '=' then
                raise I_Am_Confused;
            end if;
            if String_Utilities.Equal ("new:",  
                                       Line (1 .. 4),  
                                       Ignore_Case => True) then
                Ent.New_One := Boolean'Value (Line (5 .. Len));
            else
                raise I_Am_Confused;
            end if;

            Text_Io.Get_Line (File, Line, Len);
            if Len = 0 or else Line (1) /= '=' then
                raise I_Am_Confused;
            end if;
            if not Ent.Ignore and then  
               Ent.Unix_Name'Length > 14 and then  
               (not Ent.Directory or else  
                String_Utilities.Locate ("/", Ent.Unix_Name.all) = 0) then
                Ent.Bad_Name := True;
                Error        := True;
                Log.Put_Line ("Unix name too long," &
                              Natural'Image (Ent.Unix_Name'Length) &
                              " characters: " & Ent.Unix_Name.all,  
                              Profile.Error_Msg,  
                              Profile.Verbose);
            end if;
            Obj_Db.Define (Database, Ent.R1000_Name.all, Ent,
                           Trap_Multiples => True);
        end loop;

----Close the file.

        Text_Io.Close (File);
        if Error then
            raise Quit;
        end if;

    exception

        when Quit =>
            raise;

        when I_Am_Confused =>
            Log.Put_Line ("Database " & Name & " has bad format on line " &
                          Integer'Image (Integer (Text_Io.Line (File))),  
                          Profile.Error_Msg,  
                          Profile.Verbose);
            Text_Io.Close (File);
            raise I_Am_Confused;

        when others =>
            Log.Put_Line ("Database " & Name & " had I/O error: " &
                          Debug_Tools.Get_Exception_Name (True, True),  
                          Profile.Exception_Msg,  
                          Profile.Verbose);
            Log.Put_Line ("Error reading/on line " &
                          Integer'Image (Integer (Text_Io.Line (File))),  
                          Profile.Error_Msg,  
                          Profile.Verbose);
            begin
                Text_Io.Close (File);
            exception
                when others =>
                    null;
            end;
            raise I_Am_Confused;

    end Read_Database;

--\x0c
    procedure Write_Database (Name : String) is
------------------------------------------------------------------------------
--  Name    - Speicifies the name of the database to write
--
--  Called to write out an Ascii database file.
------------------------------------------------------------------------------
        File : Text_Io.File_Type;
        Ent  : Database_Entry;
        Iter : Obj_Db.Itrator;
        Ary  : Database_Entry_Array (1 .. Natural
                                             (Obj_Db.Cardinality (Database)));

        function Lss (Left, Right : Database_Entry) return Boolean is
        begin
            return Left.R1000_Name.all < Right.R1000_Name.all;
        end Lss;
        procedure Sort is new Table_Sort_Generic (Database_Entry,  
                                                  Natural,  
                                                  Database_Entry_Array,  
                                                  Lss);
    begin

----Open the file.

        begin
            Text_Io.Open (File, Text_Io.Out_File, Name);
        exception
            when others =>
                begin
                    Text_Io.Create (File, Text_Io.Out_File, Name);
                exception
                    when others =>
                        Log.Put_Line ("Error opening " & Name & "; exception " &
                                      Debug_Tools.Get_Exception_Name
                                         (True, True),  
                                      Profile.Exception_Msg,  
                                      Profile.Verbose);
                        raise Quit;
                end;
        end;

----Write the file.

        Obj_Db.Init (Iter, Database);
        for I in Ary'Range loop
            Ent     := Obj_Db.Eval (Database, Obj_Db.Value (Iter));
            Ary (I) := Ent;
            if not Ent.Ignore and then  
               Ent.Unix_Name'Length > 14 and then
               (not Ent.Directory or else  
                String_Utilities.Locate ("/", Ent.Unix_Name.all) = 0) then
                Ent.Bad_Name := True;
                Ent.Update   := False;
                Ent.Version  := new String (1 .. 0);
                Log.Put_Line ("Unix name too long," &
                              Natural'Image (Ent.Unix_Name'Length) &
                              " characters: " & Ent.Unix_Name.all,  
                              Profile.Error_Msg,  
                              Profile.Verbose);
            end if;
            Obj_Db.Next (Iter);
        end loop;
        Sort (Ary);
        for I in Ary'Range loop
            Ent := Ary (I);
            Text_Io.Put_Line (File, Ent.R1000_Name.all);
            Text_Io.Put_Line (File, Ent.Unix_Path.all);
            Text_Io.Put_Line (File, Ent.Unix_Name.all);
            if Ent.Update or else  
               (Ent.New_One and then Effort_Only) then
                Text_Io.New_Line (File);
            else
                Text_Io.Put_Line (File, Ent.Version.all);
            end if;
            Text_Io.Put_Line (File, "Directory: " &
                                       Boolean'Image (Ent.Directory));
            Text_Io.Put_Line (File, "Ignore: " & Boolean'Image (Ent.Ignore));
            Text_Io.Put_Line (File, "New: " & Boolean'Image (Ent.New_One));
            if Ent.New_One then
                Log.Put_Line ("New: " & Ent.R1000_Name.all,  
                              Profile.Note_Msg,  
                              Profile.Verbose);
            end if;
            Text_Io.Put_Line (File, "====");
        end loop;

----Close the file.

        Text_Io.Close (File);

    exception

        when others =>
            Log.Put_Line ("Database " & Name & " had I/O error: " &
                          Debug_Tools.Get_Exception_Name (True, True),  
                          Profile.Exception_Msg,  
                          Profile.Verbose);
            begin
                Text_Io.Close (File);
            exception
                when others =>
                    null;
            end;
            raise Quit;

    end Write_Database;

--\x0c
    function Remove_Root (Full : String;  
                          Root : String) return String is
------------------------------------------------------------------------------
--  Full    - Specifies the Full_Name of an object
--  Root    - Specifies a string that is supposed to match the initial
--              portion of Full
--
-- Removes the Root prefix from the Full name.  The initial part of Full must
-- match or we abort.
------------------------------------------------------------------------------
    begin

        if Full (Full'First .. Full'First + Root'Length - 1) /= Root then
            Log.Put_Line ("R1000_Root is " & Root,  
                          Profile.Error_Msg,  
                          Profile.Verbose);
            Log.Put_Line ("Object is not contained in R1000_Root: " & Full,  
                          Profile.Error_Msg,  
                          Profile.Verbose);
            raise Quit;
        end if;
        ----Drop the '.' that follows the Root.
        return Full (Full'First + Root'Length + 1 .. Full'Last);

    end Remove_Root;

--\x0c
    function Segment_Name (Name : String) return Natural_Array is
------------------------------------------------------------------------------
--  Name    - Specifies the name to segment.
--
-- Returns an array of indexes.  Each index indicates the place within the
-- string of a '.' or a ''' or Name'Last+1.
------------------------------------------------------------------------------
        Result  : Natural_Array (1 .. 2 + Name'Length / 2);
        Resulti : Natural := 1;
    begin

        Result (Resulti) := Name'First - 1;
        for I in Name'Range loop
            if Name (I) = '.' or else  
               Name (I) = ''' then
                Resulti          := Resulti + 1;
                Result (Resulti) := I;
            end if;
        end loop;
        Resulti          := Resulti + 1;
        Result (Resulti) := Name'Last + 1;
        return Result (1 .. Resulti);

    end Segment_Name;

--\x0c
    function Check_Database (Obj  : Dt.Object.Handle;  
                             Root : String) return Database_Entry is
------------------------------------------------------------------------------
--  Obj     - Specifies the R1000 object to be transferred to Unix
--  Root    - Specifies the root for objects, this portion of the Obj's name
--            must match and it will be removed before we process it
--
-- We take an object handle, we look it up in the database, and we return a
-- pointer to it if we want it transferred and we return null if we do not
-- want it transferred.  Makes a new entry in the database if necessary.
------------------------------------------------------------------------------
        Uni          : constant String             :=  
           Remove_Root (Dt.Naming.Unique_Full_Name (Obj),  
                        Root);
        Unique       : String (1 .. Uni'Length)    := Uni;
        Offsets      : constant Natural_Array      := Segment_Name (Unique);
        Offset_Tick  : Natural                     := Offsets'Last;
        Class        : Dt.Object.Class_Enumeration := Dt.Object.Class (Obj);
        Entrec       : Database_Entry_Rec;
        Ent          : Database_Entry;
        Subobj       : Dt.Object.Handle;
        Success      : Boolean;
        Remote_Name  : String (1 .. 1024);
        Remote_Namei : Natural                     := 0;
        Len          : Natural;
        Cap          : Boolean;
    begin

----Get the name of the object.  If it is the same name as the Root then
--  we ignore this object.

        if Dt.Naming.Full_Name (Obj) = Root then
            return null;
        end if;

----For all of the name segments that correspond to directories, make sure that
--  those directories have been processed.

        for I in Offsets'First + 1 .. Offsets'Last - 1 loop
            if Unique (Offsets (I)) /= '.' then
                Offset_Tick := I;
                exit;
            end if;
            Subobj := Dt.Naming.Resolution
                         (Root & '.' &  
                          Unique (Unique'First .. Offsets (I) - 1));  
            Ent    := Check_Object (Subobj, Root);
            if Dt.Object.Class (Subobj) = Dt.Object.Library_Class then
                if Ent.Unix_Path'Length > 0 then
                    Remote_Namei                    :=  
                       Ent.Unix_Path'Length + Ent.Unix_Name'Length + 1;
                    Remote_Name (1 .. Remote_Namei) :=
                       Ent.Unix_Path.all & Ent.Unix_Name.all & '/';
                else
                    Remote_Namei                    := Ent.Unix_Name'Length + 1;
                    Remote_Name (1 .. Remote_Namei) := Ent.Unix_Name.all & '/';
                end if;
            end if;
        end loop;

----Locate the 'V version string in the Unique name.

        for I in Offsets'First + 1 .. Offsets'Last - 1 loop
            if Unique (Offsets (I)) = ''' and then  
               Unique (Offsets (I) + 1) = 'V' then
                Entrec.Version := Hs (Unique
                                         (Offsets (I) .. Offsets (I + 1) - 1));
                Entrec.R1000_Name :=
                   Hs (Unique (Unique'First .. Offsets (I) - 1));
                exit;
            end if;
        end loop;
        if Entrec.Version = null then
            if Class /= Dt.Object.Library_Class then
                Log.Put_Line ("No 'V in Unique name???",  
                              Profile.Error_Msg,  
                              Profile.Verbose);
                raise Quit;
            else
                Entrec.R1000_Name := Hs (Unique);
                Entrec.Version    := Hs ("'V(library)");
            end if;
        end if;

----Now look up the R1000_Name in the database.  If the name was there already
--  then update the file if that is necessary.

        Obj_Db.Find (Database, Entrec.R1000_Name.all, Ent, Success);
        if Success then
            if Ent.Version.all /= Entrec.Version.all then
                Ent.Update := not Ent.Updated and not Ent.Bad_Name;
                Free_String_Pointer (Entrec.R1000_Name);
                Free_String_Pointer (Ent.Version);
                Ent.Version         := Entrec.Version;
                Ent.Full_R1000_Name := Hs (Unique);
            else
                Ent.Update := Force_Update and not Ent.Updated;
                Free_String_Pointer (Entrec.Version);
                Free_String_Pointer (Entrec.R1000_Name);
                Ent.Full_R1000_Name := Hs (Unique);
            end if;
            if Ent.Ignore then
                Ent.Update := False;
            end if;
            if not Ent.Updated and not Ent.Update then
                Files_Deferred := Files_Deferred + 1;
            end if;
            Files_Processed := Files_Processed + 1;
            return Ent;
        end if;

----Create a Unix name for this object.

        Cap := not Lower_Case_Names;
        for I in Offsets (Offset_Tick - 1) + 1 .. Offsets (Offset_Tick) - 1 loop
            if Unique (I) = '_' then
                Cap := not Lower_Case_Names;
            elsif Cap then
                if Unique (I) in 'a' .. 'z' then
                    Unique (I) := Character'Val (Character'Pos (Unique (I)) -
                                                 Integer (Character'Pos ('a') -
                                                          Character'Pos ('A')));
                end if;
                Cap := False;
            else
                if Unique (I) in 'A' .. 'Z' then
                    Unique (I) := Character'Val (Character'Pos (Unique (I)) -
                                                 Integer (Character'Pos ('A') -
                                                          Character'Pos ('a')));
                end if;
            end if;
        end loop;
        Entrec.Unix_Path := Hs (Remote_Name (1 .. Remote_Namei));
        Remote_Namei := Offsets (Offset_Tick) - Offsets (Offset_Tick - 1) - 1;
        Remote_Name (1 .. Remote_Namei) :=
           Unique (Offsets (Offset_Tick - 1) + 1 .. Offsets (Offset_Tick) - 1);

----We have a new object.  We need to create a Unix name for this object
--  and make a new database entry.

        Entrec.Directory := False;
        case Class is
            when Dt.Object.Library_Class =>
                Entrec.Unix_Name := Hs (String_Utilities.Lower_Case
                                           (Remote_Name (1 .. Remote_Namei)));
                Entrec.Directory := True;
            when Dt.Object.Ada_Class =>
                case Dt.Ada_Object.Unit_Kind'(Dt.Ada_Object.Kind (Obj)) is
                    when Dt.Ada_Object.Function_Spec |  
                         Dt.Ada_Object.Function_Instantiation =>
                        Entrec.Unix_Name :=
                           Hs (Remote_Name (1 .. Remote_Namei) & ".FNS");
                    when Dt.Ada_Object.Function_Body =>
                        Entrec.Unix_Name :=
                           Hs (Remote_Name (1 .. Remote_Namei) & ".FNB");
                    when Dt.Ada_Object.Procedure_Spec |  
                         Dt.Ada_Object.Procedure_Instantiation =>
                        Entrec.Unix_Name :=
                           Hs (Remote_Name (1 .. Remote_Namei) & ".PRS");
                    when Dt.Ada_Object.Procedure_Body =>
                        Entrec.Unix_Name :=
                           Hs (Remote_Name (1 .. Remote_Namei) & ".PRB");
                    when Dt.Ada_Object.Package_Spec |  
                         Dt.Ada_Object.Package_Instantiation =>
                        Entrec.Unix_Name :=
                           Hs (Remote_Name (1 .. Remote_Namei) & ".PKS");
                    when Dt.Ada_Object.Package_Body =>
                        Entrec.Unix_Name :=
                           Hs (Remote_Name (1 .. Remote_Namei) & ".PKB");
                    when Dt.Ada_Object.Generic_Function =>
                        Entrec.Unix_Name :=
                           Hs (Remote_Name (1 .. Remote_Namei) & ".FNG");
                    when Dt.Ada_Object.Generic_Procedure =>
                        Entrec.Unix_Name :=
                           Hs (Remote_Name (1 .. Remote_Namei) & ".PRG");
                    when Dt.Ada_Object.Generic_Package =>
                        Entrec.Unix_Name :=
                           Hs (Remote_Name (1 .. Remote_Namei) & ".PKG");
                    when others =>
                        Log.Put_Line ("R1000 Ada class " &
                                      Dt.Ada_Object.Unit_Kind'Image
                                         (Dt.Ada_Object.Unit_Kind'
                                          (Dt.Ada_Object.Kind (Obj))) &
                                      " is not supported.",  
                                      Profile.Warning_Msg,  
                                      Profile.Verbose);
                        Log.Put_Line ("Not transferred: " &
                                      Dt.Naming.Unique_Full_Name (Obj),  
                                      Profile.Warning_Msg,  
                                      Profile.Verbose);
                        raise Quit;
                end case;
            when Dt.Object.File_Class =>
                Entrec.Unix_Name := Hs (Remote_Name (1 .. Remote_Namei));
            when others =>
                Log.Put_Line ("R1000 object class " &
                              Dt.Object.Image (Class) & " is not supported.",  
                              Profile.Warning_Msg,  
                              Profile.Verbose);
                Log.Put_Line ("Not transferred: " &
                              Dt.Naming.Unique_Full_Name (Obj),  
                              Profile.Warning_Msg,  
                              Profile.Verbose);
                raise Quit;
        end case;

----Create the new database entry.

        Ent                 := new Database_Entry_Rec'(Entrec);
        Ent.Update          := False;   -- Do *not* send new entries.
        Ent.New_One         := True;    --  Let the user check the DB entry 1st.
        Ent.Full_R1000_Name := Hs (Unique);
        if Effort_Only or not Ent.Update then
            Ent.Version := new String (1 .. 0);
        end if;
        if Ent.Unix_Name'Length > 14 then
            Ent.Bad_Name := True;
            Ent.Update   := False;
            Log.Put_Line ("Unix name too long," &
                          Natural'Image (Ent.Unix_Name'Length) &
                          " characters: " & Ent.Unix_Name.all,  
                          Profile.Error_Msg,  
                          Profile.Verbose);
        end if;
        Obj_Db.Define (Database, Entrec.R1000_Name.all, Ent);
        Files_Processed := Files_Processed + 1;
        Files_Deferred  := Files_Deferred + 1;
        return Ent;

    end Check_Database;

--\x0c
    function Natural_Image (Val : Natural) return String is
------------------------------------------------------------------------------
--  Val - Specifies the value
-- Turn a natural into a string with no leading blanks.
------------------------------------------------------------------------------
        Str : constant String := Natural'Image (Val);
    begin
        return Str (Str'First + 1 .. Str'Last);
    end Natural_Image;

--\x0c
    function Duration_Image (Time : Duration) return String is
------------------------------------------------------------------------------
--  Time    - Specifies the duration
-- Ada doesn't give us a nice way to turn a Fixed quantity into a string so
-- we must hack one up.
------------------------------------------------------------------------------
        Val    : Integer := Integer (Time * Duration (1000.0));
        Valsub : Natural := (abs Val) rem 1000;
    begin
        if Valsub < 10 then
            return Natural_Image (Val / 1000) & ".00" & Natural_Image (Valsub);
        elsif Valsub < 100 then
            return Natural_Image (Val / 1000) & ".0" & Natural_Image (Valsub);
        else           return Natural_Image (Val / 1000) & "." & Natural_Image (Valsub);
        end if;
    end Duration_Image;

--\x0c
    function Get_Host_Id (Name : String) return Transport_Defs.Host_Id is
------------------------------------------------------------------------------
--  Name        - Specifies the name of some remote host
-- Returns the Host_Id of this host or else returns an empty Host_Id if the
-- name isn't known.
------------------------------------------------------------------------------
    begin
        return Transport_Name.Host_To_Host_Id (Name);
    exception
        when Transport_Name.Undefined =>
            return (1 .. 0 => 0);
    end Get_Host_Id;

--\x0c
    procedure Response (Connection : File_Transfer.Connect_Id) is
------------------------------------------------------------------------------
--  Conection   - Specifies the connection to check
-- Called to read any and all Response text that has been received from the
-- Unix_Machine host in response to any FTP command.  The response text is
-- send to the Log.
------------------------------------------------------------------------------
        Str : String (1 .. 1000);
        Len : Natural;
    begin

        while not File_Transfer.End_Of_Response (Connection) loop
            File_Transfer.Read_Response (Connection, Str, Len);
            Log.Put_Line ("Ftp: " & Str (1 .. Len),  
                          Profile.Note_Msg,  
                          Profile.Verbose);
        end loop;

    end Response;

--\x0c
    procedure Status_Ok (Status : Ftp_Defs.Status_Code) is
------------------------------------------------------------------------------
--  Status  - Specifies a status to check
-- Complains and raises Quit if the Status != Successful
------------------------------------------------------------------------------
    begin
        if Status /= Ftp_Defs.Successful then
            Log.Put_Line ("Error in Ship_To_Unix: " &
                          Ftp_Defs.Status_Code'Image (Status),  
                          Profile.Error_Msg,  
                          Profile.Verbose);
            raise Quit;
        end if;
    end Status_Ok;

--\x0c
    procedure Status_Ok (Status : Transport_Defs.Status_Code) is
------------------------------------------------------------------------------
--  Status  - Specifies a status to check
-- Complains and raises Quit if the Status != Ok.
------------------------------------------------------------------------------
    begin

        if Status /= Transport_Defs.Ok then
            Log.Put_Line ("Error in Ship_To_Unix: " &
                          Transport_Defs.Image (Status),  
                          Profile.Error_Msg,  
                          Profile.Verbose);
            raise Quit;
        end if;

    end Status_Ok;

--\x0c
    procedure Disconnect (Connection : in out File_Transfer.Connect_Id) is
------------------------------------------------------------------------------
--  Connection  - Specifies the connection to destroy
-- Called (at any time, in any state) when we must get rid of a connection.
-- We try to do it nicely but we are prepared to ignore any errors and to
-- simply drop the connection at the worst.
------------------------------------------------------------------------------
        Ftp_Status : Ftp_Defs.Status_Code;
    begin

----If the Connection isn't "open" (really means allocated) then we have nothing
--  to do.

        if Effort_Only or else  
           not File_Transfer.Is_Open (Connection) then
            return;
        end if;

----If there is an actual connection then we must try to Quit out of it.

        if File_Transfer.Is_Connected (Connection) then
            begin
                begin
                    File_Transfer.Send_Quit (Connection);
                    Response (Connection);
                    File_Transfer.Command_Status (Connection, Ftp_Status);
                    Status_Ok (Ftp_Status);

----If the Quit fails then report that but also continue.

                exception
                    when others =>
                        Log.Put_Line
                           ("Unexpected exception during File_Transfer.Send_Quit:" &  
                            Debug_Tools.Get_Exception_Name (True, True),
                            Profile.Error_Msg,  
                            Profile.Verbose);
                end;

----Try to disconnect from the remote server.

                File_Transfer.Disconnect (Connection);
            exception
                when others =>
                    Log.Put_Line
                       ("Unexpected exception during File_Transfer.Disconnect:" &  
                        Debug_Tools.Get_Exception_Name (True, True),  
                        Profile.Error_Msg,  
                        Profile.Verbose);
            end;
        end if;

----Finally we close (deallocate) the socket.

        File_Transfer.Close (Connection);

    end Disconnect;

--\x0c
    procedure Mkdir (Connection : File_Transfer.Connect_Id;  
                     Local      : String;  
                     Remote     : String) is
------------------------------------------------------------------------------
--  Conection   - Specifies the connection to use
--  Local       - Specifies the name of an existing local object
--  Remote      - Specifies the name of a remote object to be created/written
-- Called to perform (and check) the creation of a remote directory.
------------------------------------------------------------------------------
        Ftp_Status : Ftp_Defs.Status_Code;
    begin

----Inform the log of the impending creation.

        Log.Put_Line ("Create directory: " & Remote,  
                      Profile.Note_Msg,  
                      Profile.Verbose);

----Send the create directory command.

        if not Effort_Only then
            Files_Transferred := Files_Transferred + 1;
            File_Transfer.Send_Verbatim (Connection, "XMKD " & Remote);
            Response (Connection);
            File_Transfer.Command_Status (Connection, Ftp_Status);
            Status_Ok (Ftp_Status);
        end if;

    end Mkdir;

--\x0c
    procedure Store (Connection : File_Transfer.Connect_Id;  
                     Local      : String;  
                     Remote     : String) is
------------------------------------------------------------------------------
--  Conection   - Specifies the connection to use
--  Local       - Specifies the name of an existing local object
--  Remote      - Specifies the name of a remote object to be created/written
-- Called to perform (and check) the transfer of one file from the R1000 to
-- the Unix_Machine host.
------------------------------------------------------------------------------
        Ftp_Status : Ftp_Defs.Status_Code;
        Bytes      : Natural;
        Dura       : Duration;
    begin

----Copy the Ascii data into a temporary file; Ada can be such a pain; take
--  care to preserve the look-and-feel of our data.

        declare
            use Text_Io;
            Input  : File_Type;
            Output : File_Type;
            Lno    : Positive_Count := 1;
            Pno    : Positive_Count := 1;
            Line   : String (1 .. 256);
            Length : Natural;
            Eof    : Boolean        := False;
            Eop    : Boolean        := False;
            Eol    : Boolean        := False;
        begin

----Open the input and output files.

            if Effort_Only then
                return;
            end if;
            Files_Transferred := Files_Transferred + 1;

            Open (Input, In_File, Local);
            begin
                Temp_File_Used := True;
                Open (Output, Out_File, Temp_File_Name);
            exception
                when others =>
                    Create (Output, Out_File, Temp_File_Name);
            end;

----Read lines and put them out to the temporary file.

            loop

----Try to fit a line into the space available.

                if Eof then
                    if Length > 0 then
                        New_Line (Output);  -- End file with a Lf.
                    end if;
                    exit;
                end if;
                Get_Line (Input, Line, Length);
                Eof := Text_Io.End_Of_File (Input);
                Eop := Eof or else Pno /= Page (Input);
                Eol := Eop or else Length < Line'Length or else
                          Lno /= Text_Io.Line (Input);

----If we only got part of a line then put out that part.  If we got a Ff then
--  append that and add a newline.

                if Eol then
                    Put_Line (Output, Line (1 .. Length));
                    if Eop and not Eof then
                        New_Page (Output);
                        New_Line (Output);
                        Pno := Page (Input);
                    end if;
                    Lno := Text_Io.Line (Input);
                else
                    Put (Output, Line (1 .. Length));
                end if;
            end loop;

----Close the files.

            Close (Input);
            Close (Output);
        end;

----Inform the log of the impending transfer.

        for I in reverse 1 .. 5 loop
            Log.Put_Line ("Transfer: " & Local & " => " & Remote,  
                          Profile.Note_Msg,  
                          Profile.Verbose);

----Set up a new socket connection for the actual transfer.

            File_Transfer.Send_Data_Port (Connection,  
                                          Transport_Defs.Null_Host_Id,  
                                          Transport_Defs.Null_Socket_Id);
            Response (Connection);
            File_Transfer.Command_Status (Connection, Ftp_Status);
            Status_Ok (Ftp_Status);
            delay 1.0; -- Try a delay; we're getting stupid errors that
                       -- are probably timing related.

----Begin the transfer and wait for it to end.

            File_Transfer.Start_Store (Connection,  
                                       Local_Filename  => Temp_File_Name,
                                       Remote_Filename => Remote,  
                                       Append          => False);
            Response (Connection);
            File_Transfer.Command_Status (Connection, Ftp_Status);
            if Ftp_Status /= Ftp_Defs.Transfer_Complete then
                Status_Ok (Ftp_Status);
            end if;

----Inform the log of a successful transfer.

            Bytes := File_Transfer.Last_Transfer_Length (Connection);
            Dura  := File_Transfer.Last_Transfer_Time (Connection);
            Log.Put_Line  
              ("Done, bytes: " &  
                Natural_Image (Bytes) & ", seconds: " &  
                Duration_Image (Dura),  
                Profile.Note_Msg,  
                Profile.Verbose);
            if Bytes /= 0 then
                exit;  
            elsif I = 1 then
                Log.Put_Line
                   ("Arghhh!!! 0 Bytes transferred in 0.0 seconds again!!!" &
                    "  We Quit.", Profile.Error_Msg,  
                    Profile.Verbose);
                raise Quit;
            end if;
            Log.Put_Line
               ("Arghhh!!! 0 Bytes transferred in 0.0 seconds again!!!" &
                "  Trying one more time.",  
                Profile.Error_Msg,  
                Profile.Verbose);
            delay 2.0;
        end loop;

    end Store;

--\x0c
    procedure Tcp_Port_Numbers_Bug_Workaround is
        ----HP has a silly bug that we have to get-around.
        --  Assign port numbers until port numbers reach at least 1024.
        --  The R1000 assigns successive numbers starting at around 511.
        --  HP and apparently some others cannot accept any number less
        --  than 1024.  Silly bug.
        C      : Transport.Connection_Id;
        Status : Transport_Defs.Status_Code;
        Done   : Boolean := False;
    begin
        while not Done loop
            Transport.Open (C, Status, "TCP/IP");
            exit when Transport_Defs."/=" (Status, Transport_Defs.Ok);
            declare
                Port : constant Transport_Defs.Socket_Id :=
                   Transport.Local_Socket (C);
            begin
                Done := Byte_Defs.">=" (Port (Port'First), 4);
            end;
            Transport.Close (C);
        end loop;
    end Tcp_Port_Numbers_Bug_Workaround;

--\x0c
    function Check_Object (Obj  : Dt.Object.Handle;  
                           Root : String) return Database_Entry is
------------------------------------------------------------------------------
--  Obj     - Specifies the object to check
--  Root    - Specifies the local root path
--
-- Does a Check_Database followed by an update of the object if that is
-- desirable.
------------------------------------------------------------------------------
        Dbentry : Database_Entry;
    begin

        Dbentry := Check_Database (Obj, Root);
        if Dbentry.Update and not Dbentry.Updated then
            if Dbentry.Directory then
                Mkdir (Connection,  
                       Root & "." & Dbentry.Full_R1000_Name.all,  
                       Dbentry.Unix_Path.all & Dbentry.Unix_Name.all);
            else
                Store (Connection,  
                       Root & "." & Dbentry.Full_R1000_Name.all,  
                       Dbentry.Unix_Path.all & Dbentry.Unix_Name.all);
            end if;
            if not Effort_Only then
                Dbentry.Update  := False;
                Dbentry.Updated:= True;
            end if;
            Log.Put_Line ("-----------------------------------------------",  
                          Profile.Note_Msg,  
                          Profile.Verbose);
        end if;
        return Dbentry;

    exception

        when Quit =>
            ----Mark his as "not done".
            Dbentry.Version := new String (1 .. 0);
            raise;

    end Check_Object;

--\x0c
begin

    if Unix_Machine /= "<SHIP_TO_MACHINE>" then
        Host_Machine_Name := new String'(Unix_Machine);
    else
        declare
            Env : String_Pointer :=
               X_Env_Get_Environment_Variable ("SHIP_TO_MACHINE");
        begin
            if Env = null then
                Log.Put_Line
                   ("Unix_Machinge => <SHIP_TO_MACHINE> and environment variable SHIP_TO_MACHINE is not set.  Use the Setenv command to set it.",
                    Profile.Error_Msg);
                raise Library.Error;
            else
                Host_Machine_Name := new String'(Env.all);
            end if;
        end;
    end if;

    if Username /= "<SHIP_TO_USERNAME>" then
        Host_User_Name := new String'(Username);
    else
        declare
            Env : String_Pointer :=
               X_Env_Get_Environment_Variable ("SHIP_TO_USERNAME");
        begin
            if Env = null then
                Log.Put_Line
                   ("Username => <SHIP_TO_USERNAME> and environment variable SHIP_TO_USERNAME is not set.  Use the Setenv command to set it.",
                    Profile.Error_Msg);
                raise Library.Error;
            else
                Host_User_Name := new String'(Env.all);
            end if;
        end;
    end if;

    declare

        Td_Status  : Transport_Defs.Status_Code;
        Ftp_Status : Ftp_Defs.Status_Code;
        Host_Id    : constant Transport_Defs.Host_Id  
            := Get_Host_Id (Host_Machine_Name.all);
        Ascii_Mode : Boolean;

        Local_Root      : Dt.Object.Handle;
        Local_Root_Name : String_Pointer;
        Local_Files     : Dt.Object.Iterator;

        Dbentry : Database_Entry;

    begin

----Say hello to the user; let him know we are alive.

        Log.Put_Line ("[Ship_To_Unix("  
                       & R1000_Files & ','  
                       & R1000_Root & ','  
                       & Unix_Root & ','  
                       & Host_Machine_Name.all & ','  
                       & Host_User_Name.all & ','  
                       & Database_Name & ","  
                       & "Force_Update => " & Boolean'Image (Force_Update) & ","  
                       & "Effort_Only => " & Boolean'Image (Effort_Only) & ")]",
                      Profile.Auxiliary_Msg, Profile.Verbose);

----Make sure that the Host_Machine_Name host is known to the R1000.

        if Host_Id'Length = 0 then
            Log.Put_Line
               ("Host name [" & Host_Machine_Name.all &
                "] is not in the Transport_Name_Map (Host name undefined).",
                Profile.Error_Msg,  
                Profile.Verbose);
            return;
        end if;

----Resolve the various file names that we were given.

        Local_Root := Dt.Naming.Resolution (R1000_Root);
        if Dt.Object.Is_Bad (Local_Root) then
            Log.Put_Line ("R1000_Root argument is bad.  {" &
                          Dt.Object.Message (Local_Root) & '}',  
                          Profile.Error_Msg,  
                          Profile.Verbose);
            return;
        end if;
        Local_Root_Name := Hs (Dt.Naming.Full_Name (Local_Root));

        Local_Files := Dt.Naming.Resolution (R1000_Files);
        if Dt.Object.Is_Bad (Local_Files) then
            Log.Put_Line ("R1000_Files argument is bad.  {" &
                          Dt.Object.Message (Local_Files) & '}',  
                          Profile.Error_Msg,  
                          Profile.Verbose);
            return;
        end if;

----Initialiaze our object map.

        Obj_Db.Initialize (Database);
        Read_Database (Database_Name);

----Try to get a socket for our use.

        if not Effort_Only then
            Log.Put_Line ("Get network socket.",
                          Profile.Note_Msg, Profile.Verbose);
            Tcp_Port_Numbers_Bug_Workaround;
            File_Transfer.Open (Connection, Td_Status);
            Status_Ok (Td_Status);

----Try to call up the Host_Machine_Name.all and see if it will talk to us at
--  all.

            Log.Put_Line ("Connect to " & Host_Machine_Name.all,
                          Profile.Note_Msg, Profile.Verbose);
            File_Transfer.Connect (Connection, Host_Id);
            Response (Connection);
            File_Transfer.Command_Status (Connection, Ftp_Status);
            Status_Ok (Ftp_Status);

----Try to log in as the Username/Password that was given to us.

            Log.Put_Line ("Send username.", Profile.Note_Msg, Profile.Verbose);
            File_Transfer.Send_Username (Connection, Host_User_Name.all);
            Response (Connection);
            File_Transfer.Command_Status (Connection, Ftp_Status);
            if Ftp_Status = Ftp_Defs.Not_Logged_In then
                Log.Put_Line ("Username " & Host_User_Name.all &
                              " invalid on workstation " &
                              Host_Machine_Name.all, Profile.Error_Msg,  
                              Profile.Verbose);
                raise Quit;
            elsif Ftp_Status = Ftp_Defs.Need_Password then
                Log.Put_Line ("Send password.", Profile.Note_Msg,
                              Profile.Verbose);
                File_Transfer.Send_Password (Connection, Password);
                Response (Connection);
                File_Transfer.Command_Status (Connection, Ftp_Status);
            end if;
            if Ftp_Status = Ftp_Defs.Not_Logged_In then
                Log.Put_Line ("Password invalid for username " &
                              Host_User_Name.all & " on workstation " &
                              Host_Machine_Name.all, Profile.Error_Msg,  
                              Profile.Verbose);
                raise Quit;
            end if;
            Status_Ok (Ftp_Status);

-- ----Set the account for the logged-in job Host_Machine_Name.
--
--         if Account /= "" and then
--            Account /= " " then
--             Log.Put_Line ("Send account.", Profile.Note_Msg, Profile.Verbose);
--             File_Transfer.Send_Account (Connection, Account);
--             Response (Connection);
--             File_Transfer.Command_Status (Connection, Ftp_Status);
--             if Ftp_Status /= Ftp_Defs.Command_Not_Implemented then
--                 Status_Ok (Ftp_Status);
--             end if;
--         end if;
--
----Connect to the Unix_Root directory.

            Log.Put_Line ("Connect to " & Unix_Root,
                          Profile.Note_Msg, Profile.Verbose);
            File_Transfer.Send_Cwd (Connection, Unix_Root);
            Response (Connection);
            File_Transfer.Command_Status (Connection, Ftp_Status);
            Status_Ok (Ftp_Status);

----We will be working in Stream mode, sending Ascii data, and working in
--  units of Files.  These should work on all FTP implementations.

            Log.Put_Line
               ("Set transfer modes (Stream,Image/Telnet/Ascii,File).",
                Profile.Note_Msg, Profile.Verbose);
            File_Transfer.Set_Mode (Connection, Ftp_Defs.Stream);
            Response (Connection);
            File_Transfer.Command_Status (Connection, Ftp_Status);
            Status_Ok (Ftp_Status);

            Ascii_Mode := True;
            File_Transfer.Set_Type (Connection, Ftp_Defs.Image);
            Response (Connection);
            File_Transfer.Command_Status (Connection, Ftp_Status);
            if Ftp_Status /= Ftp_Defs.Successful then
                File_Transfer.Set_Type (Connection, Ftp_Defs.Ascii_Telnet);
                Response (Connection);
                File_Transfer.Command_Status (Connection, Ftp_Status);
                if Ftp_Status /= Ftp_Defs.Successful then
                    File_Transfer.Set_Type (Connection, Ftp_Defs.Ascii);
                    Response (Connection);
                    File_Transfer.Command_Status (Connection, Ftp_Status);
                end if;
            end if;
            Status_Ok (Ftp_Status);

            File_Transfer.Set_Structure (Connection, Ftp_Defs.File);
            Response (Connection);
            File_Transfer.Command_Status (Connection, Ftp_Status);
            Status_Ok (Ftp_Status);
        end if;

----Send all of the various files.

        -- if not Ascii_Mode then
        --     Log.Put_Line ("Set transmission modes (Stream,Ascii,File).",
        --                   Profile.Note_Msg, Profile.Verbose);
        --     Ascii_Mode := True;
        --     File_Transfer.Set_Type (Connection, Ftp_Defs.Ascii);
        --     Response (Connection);
        --     File_Transfer.Command_Status (Connection, Ftp_Status);
        --     Status_Ok (Ftp_Status);
        -- end if;
        while not Dt.Object.Done (Local_Files) loop
            Dbentry := Check_Object
                          (Dt.Object.Value (Local_Files), Local_Root_Name.all);
            Dt.Object.Next (Local_Files);
        end loop;

----We are all done; say "bye", disconnect, and free up the socket.

        Log.Put_Line ("Disconnect.", Profile.Note_Msg, Profile.Verbose);
        Disconnect (Connection);

----Now write out the database.

        Log.Put_Line ("Write database.", Profile.Note_Msg, Profile.Verbose);
        Write_Database (Database_Name);
        if Temp_File_Used then
            Library.Delete (Temp_File_Name, Response => "<ERROR>");
        end if;

----We are done.

        Log.Put_Line ("Processed:  " &
                      Integer'Image (Files_Processed) & " files.",
                      Profile.Note_Msg);
        Log.Put_Line ("Deferred:   " &
                      Integer'Image (Files_Deferred) & " files.",
                      Profile.Note_Msg);
        Log.Put_Line ("Transferred:" &
                      Integer'Image (Files_Transferred) & " files.",
                      Profile.Note_Msg);
        Log.Put_Line ("[end of Ship_To_Unix]",  
                      Profile.Auxiliary_Msg,  
                      Profile.Verbose);

    exception

----When we Quit we simply disconnect; error messages have already gone out.

        when Quit =>
            if Force_Update then  
                Log.Put_Line ("Updating internal database.",
                              Profile.Note_Msg, Profile.Verbose);
                while not Dt.Object.Done (Local_Files) loop
                    Dbentry := Check_Database (Dt.Object.Value (Local_Files),
                                               Local_Root_Name.all);
                    Dbentry.Version := new String (1 .. 0);
                    Dt.Object.Next (Local_Files);
                end loop;
            end if;
            Log.Put_Line ("Write database.", Profile.Note_Msg, Profile.Verbose);
            Write_Database (Database_Name);
            Disconnect (Connection);
            raise Library.Error;

----Anything else is simply unexpected.

        when others =>
            Log.Put_Line ("Unexpected exception during Ship_To_Unix script:" &  
                          Debug_Tools.Get_Exception_Name (True, True),  
                          Profile.Error_Msg,  
                          Profile.Verbose);
            Disconnect (Connection);

    end;

end Ship_To_Unix;

E3 Meta Data

    nblk1=53
    nid=0
    hdr6=a6
        [0x00] rec0=23 rec1=00 rec2=01 rec3=036
        [0x01] rec0=10 rec1=00 rec2=02 rec3=03a
        [0x02] rec0=19 rec1=00 rec2=03 rec3=000
        [0x03] rec0=1c rec1=00 rec2=52 rec3=014
        [0x04] rec0=00 rec1=00 rec2=04 rec3=062
        [0x05] rec0=17 rec1=00 rec2=05 rec3=06e
        [0x06] rec0=00 rec1=00 rec2=53 rec3=018
        [0x07] rec0=1a rec1=00 rec2=06 rec3=040
        [0x08] rec0=00 rec1=00 rec2=51 rec3=020
        [0x09] rec0=19 rec1=00 rec2=07 rec3=00e
        [0x0a] rec0=00 rec1=00 rec2=50 rec3=00c
        [0x0b] rec0=1c rec1=00 rec2=08 rec3=03a
        [0x0c] rec0=00 rec1=00 rec2=4f rec3=004
        [0x0d] rec0=21 rec1=00 rec2=09 rec3=028
        [0x0e] rec0=1e rec1=00 rec2=0a rec3=018
        [0x0f] rec0=00 rec1=00 rec2=4e rec3=00c
        [0x10] rec0=1c rec1=00 rec2=0b rec3=048
        [0x11] rec0=19 rec1=00 rec2=0c rec3=01a
        [0x12] rec0=16 rec1=00 rec2=0d rec3=088
        [0x13] rec0=01 rec1=00 rec2=4d rec3=00c
        [0x14] rec0=1e rec1=00 rec2=0e rec3=052
        [0x15] rec0=1a rec1=00 rec2=0f rec3=030
        [0x16] rec0=00 rec1=00 rec2=4c rec3=002
        [0x17] rec0=19 rec1=00 rec2=10 rec3=03a
        [0x18] rec0=00 rec1=00 rec2=4b rec3=004
        [0x19] rec0=17 rec1=00 rec2=11 rec3=048
        [0x1a] rec0=00 rec1=00 rec2=4a rec3=00e
        [0x1b] rec0=16 rec1=00 rec2=12 rec3=032
        [0x1c] rec0=20 rec1=00 rec2=13 rec3=08a
        [0x1d] rec0=19 rec1=00 rec2=14 rec3=056
        [0x1e] rec0=1b rec1=00 rec2=15 rec3=038
        [0x1f] rec0=00 rec1=00 rec2=49 rec3=026
        [0x20] rec0=10 rec1=00 rec2=16 rec3=01c
        [0x21] rec0=00 rec1=00 rec2=47 rec3=050
        [0x22] rec0=1c rec1=00 rec2=48 rec3=030
        [0x23] rec0=01 rec1=00 rec2=17 rec3=05e
        [0x24] rec0=15 rec1=00 rec2=18 rec3=016
        [0x25] rec0=01 rec1=00 rec2=46 rec3=014
        [0x26] rec0=18 rec1=00 rec2=19 rec3=018
        [0x27] rec0=00 rec1=00 rec2=45 rec3=006
        [0x28] rec0=19 rec1=00 rec2=1a rec3=012
        [0x29] rec0=00 rec1=00 rec2=43 rec3=010
        [0x2a] rec0=12 rec1=00 rec2=1b rec3=094
        [0x2b] rec0=14 rec1=00 rec2=1c rec3=054
        [0x2c] rec0=11 rec1=00 rec2=1d rec3=028
        [0x2d] rec0=10 rec1=00 rec2=1e rec3=04a
        [0x2e] rec0=16 rec1=00 rec2=1f rec3=024
        [0x2f] rec0=18 rec1=00 rec2=44 rec3=010
        [0x30] rec0=01 rec1=00 rec2=20 rec3=018
        [0x31] rec0=15 rec1=00 rec2=21 rec3=018
        [0x32] rec0=01 rec1=00 rec2=42 rec3=002
        [0x33] rec0=17 rec1=00 rec2=22 rec3=016
        [0x34] rec0=18 rec1=00 rec2=23 rec3=064
        [0x35] rec0=1c rec1=00 rec2=24 rec3=02e
        [0x36] rec0=18 rec1=00 rec2=25 rec3=056
        [0x37] rec0=19 rec1=00 rec2=26 rec3=012
        [0x38] rec0=1b rec1=00 rec2=27 rec3=03c
        [0x39] rec0=17 rec1=00 rec2=28 rec3=02c
        [0x3a] rec0=1f rec1=00 rec2=29 rec3=064
        [0x3b] rec0=02 rec1=00 rec2=41 rec3=022
        [0x3c] rec0=1c rec1=00 rec2=2a rec3=012
        [0x3d] rec0=1d rec1=00 rec2=2b rec3=00a
        [0x3e] rec0=16 rec1=00 rec2=2c rec3=006
        [0x3f] rec0=00 rec1=00 rec2=40 rec3=002
        [0x40] rec0=1b rec1=00 rec2=2d rec3=05a
        [0x41] rec0=18 rec1=00 rec2=2e rec3=04c
        [0x42] rec0=00 rec1=00 rec2=3f rec3=00e
        [0x43] rec0=17 rec1=00 rec2=2f rec3=03e
        [0x44] rec0=00 rec1=00 rec2=3e rec3=002
        [0x45] rec0=20 rec1=00 rec2=30 rec3=006
        [0x46] rec0=1d rec1=00 rec2=31 rec3=058
        [0x47] rec0=00 rec1=00 rec2=3d rec3=008
        [0x48] rec0=1c rec1=00 rec2=32 rec3=00e
        [0x49] rec0=00 rec1=00 rec2=3c rec3=012
        [0x4a] rec0=17 rec1=00 rec2=33 rec3=03e
        [0x4b] rec0=1d rec1=00 rec2=34 rec3=02c
        [0x4c] rec0=11 rec1=00 rec2=35 rec3=08c
        [0x4d] rec0=17 rec1=00 rec2=36 rec3=004
        [0x4e] rec0=17 rec1=00 rec2=37 rec3=032
        [0x4f] rec0=17 rec1=00 rec2=38 rec3=03c
        [0x50] rec0=18 rec1=00 rec2=39 rec3=006
        [0x51] rec0=1a rec1=00 rec2=3a rec3=014
        [0x52] rec0=18 rec1=00 rec2=3b rec3=001
    tail 0x21500ad0481978eb3390a 0x42a00088462063203