[comp.os.vms] Accessing VMSMAIL.DAT

VPE@IFASGNV.BITNET (VAX-PRO Express) (08/29/87)

In response to the request for some code to access VMSMAIL.DAT:
here's some Pascal that does the job,  though a quick hack.  It
works for us.

George Fischer

bitnet:  grf@ifasgnv
csnet:   fischer@mosquito.cis.ufl.edu



PROGRAM get_mail_info (input,output);

(*
 *  R W Rourk     4/10/87        original writer.
 *  G R Fischer   8/01/87        cleaned it up a tad. still a hack...
 *
 *  get_mail_info
 *
 *  is a function aiding the applications programmer in finding a users
 *  mail information via VMSMAIL.DAT.  It returns true if there is
 *  an entry for the the user USERNAME and there were no file errors.  Process
 *  requires privilege such as BYPASS or READALL to function. If true returned,
 *  then the almost complete mail directory specification (e.g. [username.mail],
 *  no disk specification!), the forwarding address (null string if none)
 *  and the user's personal name (likewise null if none)  are returned.
 *)

CONST
  string_length = 255;

TYPE
  string = VARYING [string_length] OF CHAR;


PROCEDURE to_upper (VAR s : string);

VAR
  i : INTEGER;

BEGIN
  FOR i := 1 TO s.length DO
      IF s[i] IN ['a'..'z'] THEN
         s[i] := CHR (ORD('A') - ORD('a') + ORD (s[i]))
END;


FUNCTION get_mail_info (username : string;
                        VAR mail_directory,
                            forwarding_address,
                            personal_name  : string):BOOLEAN;

(*
 *  VMSMAIL Record Type  --  well,  it works,  anyway.
 *)


TYPE
  vmsmail_record = [UNSAFE] RECORD
                            username : [KEY(0)] PACKED ARRAY [1..31] OF CHAR;
                            remainder: array [1..256] of char;
                            END;


VAR
  temp : string;
  user_field : PACKED ARRAY [1..31] OF CHAR;

  mail : FILE OF vmsmail_record;
  pos, h, st, g: INTEGER;

  field_lengths : array [1..4] OF INTEGER;

  file_buffer_undefined : BOOLEAN;

  TESTING : [EXTERNAL] BOOLEAN;


BEGIN
   to_upper (username);

   FOR h := 1 TO MIN (31,  username.length) DO
      user_field [h] := username [h];

   FOR h := 1 + MIN (31,  username.length) TO 31 DO
      user_field [h] := ' ';

   OPEN (mail,
         'SYS$SYSTEM:VMSMAIL.DAT',
          ACCESS_METHOD := keyed,
          ORGANIZATION := indexed,
          HISTORY := readonly,
          SHARING := readwrite,
          ERROR := continue);

   resetk (mail, 0, ERROR := CONTINUE);
   findk (mail, 0, user_field, ERROR:=CONTINUE);

   st   := status (mail);
   file_buffer_undefined := ufb (mail);

   CLOSE (mail, error := continue);

   IF ((st <> 0) OR file_buffer_undefined) THEN

      BEGIN
      IF st <> 0 THEN
         BEGIN                  (* too lazy to do this the right way... *)
         IF st = 114 THEN
            writeln ('privilege violation reading VMSMAIL.DAT')
         ELSE
            writeln ('can''t access VMSMAIL.DAT for ''', username, '''',
                    ', RMS error status ', st:1)
         END
      ELSE
         writeln ('''', username, ''' not found in VMSMAIL.DAT',
                  error := continue);

      personal_name      := '';
      mail_directory     := '';
      forwarding_address := '';
      get_mail_info  := FALSE;

      END

  ELSE
      BEGIN
      get_mail_info := TRUE;

     (*
      *  extract length codes out of record for forwarding addr, personal
      *  name, and directory
      *)

      FOR g := 1 TO 4 DO
          field_lengths [g] := ORD (mail^.remainder [33 + g]);

      pos := 38;

      forwarding_address := '';

      IF field_lengths [4] > 0 THEN

         FOR g := 1 to MIN (STRING_LENGTH, field_lengths [4]) do
             BEGIN
             forwarding_address := forwarding_address +
                                   mail^.remainder [pos];
             pos := pos + 1;
             END;

      personal_name := '';

      IF field_lengths [3] > 0 THEN

         FOR g := 1 to MIN (STRING_LENGTH, field_lengths [3]) do
             BEGIN
             personal_name := personal_name +  mail^.remainder [pos];
             pos := pos + 1;
             END;

    (*
     *    copy directory -- top level account name is the same as username (on
     *    our system at least) so start with that.
     *)

       mail_directory :=  '[';

       h := 1;
       WHILE (user_field [h] <> ' ') AND (h <= 30) DO
              BEGIN
              mail_directory := mail_directory + user_field [h];
              h := h + 1;
              END;                             (* have "[username" so far... *)

      h := h + 1;
      pos := pos + 1;

      IF field_lengths [2] > 0 THEN
         FOR g:= 2 TO field_lengths [2] DO    (* skip the "[" of "[.sub-dir]" *)
             BEGIN
             mail_directory := mail_directory + mail^.remainder [pos];
             pos := pos + 1;
             END
      ELSE                                    (* no sub-directory - add "]" *)

         mail_directory := mail_directory + ']';
      END;

END;


LABEL
  KNUTH_SEZ;

VAR
  name, dir, forw, pers : string;

BEGIN

writeln ('enter a username, ^z to exit');

KNUTH_SEZ:
  name := '';
  writeln;
  write ('enter username: ');
  IF NOT EOF THEN
     BEGIN
     readln (name);
     IF get_mail_info (name, dir, forw, pers) THEN
        BEGIN
        writeln ('mail directory: ''', dir, '''');
        writeln ('forwarding address: ''', forw, '''');
        writeln ('personal name: ''', pers, '''')
        END;
     GOTO KNUTH_SEZ
     END
END.