-- COPYRIGHT © 1989-1990 BY
-- DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASSACHUSETTS.
-- ALL RIGHTS RESERVED.
--
-- THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
-- ONLY  IN  ACCORDANCE  OF  THE  TERMS  OF  SUCH  LICENSE  AND WITH THE
-- INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR  ANY  OTHER
-- COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
-- OTHER PERSON.  NO TITLE TO AND  OWNERSHIP OF THE  SOFTWARE IS  HEREBY
-- TRANSFERRED.
--
-- THE INFORMATION IN THIS SOFTWARE IS  SUBJECT TO CHANGE WITHOUT NOTICE
-- AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
-- CORPORATION.
--
-- DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE  OR  RELIABILITY OF ITS
-- SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.

with SYSTEM;
with STARLET;
with TEXT_IO;
with CONDITION_HANDLING;

-- ++
-- FACILITY:
--  
--   SYS$EXAMPLES
--  
-- ABSTRACT:
--  
--   This module illustrates how to write a site-specific password filter in
--   Ada.
--
--   To build your own site-specific password policy shareable image, use the
--   following commands:
--
--	$ ADA SYS$EXAMPLES:VMS$PASSWORD_POLICY
--	$ ACS EXPORT/OBJECT=VMS$PASSWORD_POLICY PASSWORD_POLICY
--	$ @SYS$EXAMPLES:VMS$PASSWORD_POLICY_LNK
--
--   Once you've built the image you must then copy it to SYS$LIBRARY, install
--   the image, and enable the callout by setting the SYSGEN parameter
--   LOAD_PWD_POLICY to 1:
--   
--	$ COPY VMS$PASSWORD_POLICY.EXE SYS$COMMON:[SYSLIB]/PROT=(W:RE)
--      $ INSTALL ADD SYS$LIBRARY:VMS$PASSWORD_POLICY/OPEN/HEAD/SHARE
--	$ MCR SYSGEN
--	SYSGEN> USE ACTIVE
--	SYSGEN> SET LOAD_PWD_POLICY 1
--	SYSGEN> WRITE ACTIVE
--	SYSGEN> WRITE CURRENT
--
--   Please consult the "VMS System Generation Utility Manual" for further
--   information on using the SYSGEN utility.  You might also want to add the
--   following line to SYS$SYSTEM:MODPARAMS.DAT:
--
--	LOAD_PWD_POLICY = 1	    ! enable site-specific password filters
-- 
--
-- AUTHOR:
--  
--   Derrell D. Piper, October 1989
--  
-- MODIFICATION HISTORY:
--  
-- --

package PASSWORD_POLICY is

    procedure POLICY_PLAINTEXT (STATUS   : out CONDITION_HANDLING.COND_VALUE_TYPE;
				PASSWORD : in STRING; 
				USERNAME : in STRING);

    procedure POLICY_HASH (STATUS   : out CONDITION_HANDLING.COND_VALUE_TYPE;
			   HASH	    : in SYSTEM.UNSIGNED_QUADWORD; 
			   USERNAME : in STRING);

    pragma EXPORT_VALUED_PROCEDURE (
	INTERNAL => POLICY_PLAINTEXT,
	EXTERNAL => POLICY_PLAINTEXT,
	PARAMETER_TYPES => (CONDITION_HANDLING.COND_VALUE_TYPE, STRING, STRING));

    pragma EXPORT_VALUED_PROCEDURE (
	INTERNAL => POLICY_HASH,
	EXTERNAL => POLICY_HASH,
	PARAMETER_TYPES => (CONDITION_HANDLING.COND_VALUE_TYPE, SYSTEM.UNSIGNED_QUADWORD, STRING));

end PASSWORD_POLICY;

package body PASSWORD_POLICY is

procedure POLICY_PLAINTEXT (STATUS   : out CONDITION_HANDLING.COND_VALUE_TYPE;
			    PASSWORD : in STRING; 
			    USERNAME : in STRING) is
-- ++
-- FUNCTIONAL DESCRIPTION:
--
--    This procedure could filter plaintext password strings according to a
--    site-specific policy.  As a demonstration, it just prints out the
--    plaintext password and its associated username.  $GETUAI could be used to
--    retrieve additional information pertaining to the user.
--
-- FORMAL PARAMETERS:
--  
--   PASSWORD	    plaintext password string entered by user
--   USERNAME	    associated username
--  
-- IMPLICIT INPUTS:
--  
--   NONE
--  
-- IMPLICIT OUTPUTS:
--  
--   NONE
--
-- RETURN VALUE:
--
--   STARLET.SS_NORMAL     password is acceptable
--   STARLET.SS_PWDWEAK    password is too easy to guess
--   
-- SIDE EFFECTS:
--  
--   NONE
--  
-- --

--
-- The following constant definition should be removed once this value is
-- included in package STARLET.
--
    SS_PWDWEAK	: constant := 3706;

begin
    TEXT_IO.PUT("Password = ");
    TEXT_IO.PUT(PASSWORD);
    TEXT_IO.PUT(", Username = ");
    TEXT_IO.PUT_LINE(USERNAME);

    STATUS := STARLET.SS_NORMAL;
end POLICY_PLAINTEXT;

procedure POLICY_HASH (STATUS	: out CONDITION_HANDLING.COND_VALUE_TYPE;
		       HASH	: in SYSTEM.UNSIGNED_QUADWORD;
		       USERNAME : in STRING) is
-- ++
-- FUNCTIONAL DESCRIPTION:
--
--    This procedure could filter the password hash value according to a
--    site-specific policy.  As a demonstration, it just prints out the
--    quadword hash value and its associated username.  $GETUAI could be used
--    to retrieve additional information pertaining to the user.
--
-- FORMAL PARAMETERS:
--  
--   HASH	    quadword password hash
--   USERNAME	    associated username
--  
-- IMPLICIT INPUTS:
--  
--   NONE
--  
-- IMPLICIT OUTPUTS:
--  
--   NONE
--  
-- RETURN VALUE:
--
--   STARLET.SS_NORMAL     password is acceptable
--   STARLET.SS_PWDWEAK    password is too easy to guess
--   
-- SIDE EFFECTS:
--  
--   NONE
--  
-- --

--
-- The following constant definition should be removed once this value is
-- included in package STARLET.
--
    SS_PWDWEAK	: constant := 3706;

    L0	: STRING(1..10);
    L1	: STRING(1..10);
    S	: CONDITION_HANDLING.COND_VALUE_TYPE;

begin
    --
    -- Use $FAO to format the component longwords of the hash quadword.
    --
    STARLET.FAO (
        STATUS => S,
        CTRSTR => "%X!XL",
        OUTBUF => L0,
        P1     => HASH.L0);

    STARLET.FAO (
        STATUS => S,
        CTRSTR => "%X!XL",
        OUTBUF => L1,
        P1     => HASH.L1);
    
    TEXT_IO.PUT("Hash = ");
    TEXT_IO.PUT(L0);
    TEXT_IO.PUT(" ");
    TEXT_IO.PUT(L1);
    TEXT_IO.PUT(" Username = ");
    TEXT_IO.PUT_LINE(USERNAME);
    
    STATUS := STARLET.SS_NORMAL;    
end POLICY_HASH;

end PASSWORD_POLICY;