/* ------------------------------------------------------------------------
:Program.    ListClient 3.0
:Contents.   transfers mail from a mailing list to a group and vice versa
:Author.     Kai Bolay [kai]
:Address.    Snail Mail:              EMail:
:Address.    Hoffmannstraße 168       UUCP: kai@amokle.stgt.sub.org
:Address.    D-71229 Leonberg         FIDO: 2:2407/106.3
:History.    v1.0 [kai] 23-Sep-93
:History.    v1.0 [kai] 14-Nov-93 added MakeFlags()
:History.    v2.0 [kai]  3-Dec-93 removed links, added "oid<>"-support
:History.    v2.1 [kai]  3-Dec-93 only move local msgs from group to ml
:History.    v3.0 [hG ] 07 Aug 94 argument parsing, new command line syntax,
                                  default login name and passwd, config var,
                                  uses UMSInitStem,  "Mailinglist 'foo'",
                                  auto enter of new incoming mailinglists,
:History.    v3.1 [hG ] 26 Sep 94 new option 'DebugLevel=DBG/N/K' (default: 5),
                                  changed info message levels, more/better
                                  info messages
:Copyright.  Public Domain
:Language.   ARexx
:Translator. RexxMast
------------------------------------------------------------------------ */
/*--- ListClient.rexx -----------------------------------------------------

    ListClient.rexx V3.0
    ====================

ListClient is a tool to sort mails from incoming mailing lists into
local newsgroups (import mode) or sends posting in this newsgroups to
the corresponding mailinglist (export mode).

How does it work?
-----------------
IMPORT:
  All incoming mails are scanned for ReplyAddr matching "Mailinglist
  '#?'" (case insensitive). The mails are put into the newsgroup
  mailinglist.#?, where #? is substituted by the #? of the above
  pattern. Further, the mailinglists name and address are added to
  the config variable, if not already present.

EXPORT:
  All newsgroups found in the config varibale are scanned for new
  postings. This were forwarded to the corresponding mailinglist by
  sending it to the address found in the config variable.


For using ListClient, it's quite usefull to have an extra user who
gets all the mailinglists. This user must have the following
configuration variables (V11 style):
    ( READACCESS "#?" )
    ( WRITEACCESS "mailinglist.#?" )
    ( IMPORT "#?" )
For security reasons, set
    ( EXPORT "~(#?)" )
and restrict NETACCESS as far as possible (if at all).


Usage:
-----

Template: Name,Password,Server/K,Export/S,DebugLevel=DBG/N/K

Name
Password
Server
  UMS standard command line options
  (defaults to "Lists", "", ""; changeable at top of script)

Export
  Export posting to newsgroups. If this switch is not set, ListClient
  will try to move mails to newsgroups.

DebugLevel=DBG
  messages with log level lower or equal this value are not only
  written to the UMS Logfile, but also to StdIO.
  (default: 5; changeable at top of script)


Installation:
-------------

For using ListClient, it's quite usefull to have an extra user who
gets all the mailinglists. This user must have the following
configuration variables (V11 style):
    ( READACCESS "#?" )
    ( WRITEACCESS "mailinglist.#?" )
    ( IMPORT "#?" )
For security reasons, set
    ( EXPORT "~(#?)" )
and restrict NETACCESS as far as possible (if at all).

If you use an already existing user, make sure, his/her config
matches the above. But beware: is may be a security leak. I porpose
the use of an extra user for thus deamon stuff handling.

Further configuration is not nesseccary! ListClient will enter all
incoming mailinglist into it's config variable.

For the case you got some postings to be exported to mailinglists not
already present in the config variable, this is the format :-)
    ( ListClient.Mailinglists
        "Ums-Dev , Ums-Dev@umshq.dfv.rwth-aachen.de\n"
        "oberon-a , oberon-a@wossname.apana.org.au\n"
        "AMOK , AMOK@amokle.stgt.sub.org" )


Advanced Features:
------------------

Okay, for guys willing to but some fingers into the ARexx script,
here where some hints.

- Default login options are set at the top of the script.
- The prefix for newsgroups is defined in 'GroupPrefix'
- The config variables name is ProgramName || ".Mailinglists"


-------------------------------------------------------------------------*/

ProgramName = "ListClient";
ArgsTemplate = "Name,Password,Server/K,Export/S,DebugLevel/N/K"

/* set default options */
Name = "Lists"
Password = "";
Export = 0;
DebugLevel = 5;

GroupPrefix = "mailinglist."

/*** Startup ***/

call addlib("hgrexxsupport.library",0,-30);
interpret include("REXX:ums/UMSInitStem.rexx")
if rc ~= 0 then do
  say "cannot read UMS include-file!"
  exit 20
end

/*** Login ***/

account = UMSLogin(name, password, server)
if account = 0 then do
  say "unable to login."
  exit
end

/*** Magic ***/

FLAGS.01 = MakeFlags(0,1)
FLAGS.012 = MakeFlags(0,1,2)
Mailinglists = ReadUMSConfig(account,ProgramName || ".Mailinglists");

IF ~ Export then
  call Import()
else do
  trace ?
  if Mailinglists = '' then do
    log(4,ProgramName || ": nothing to export, no mailinglists defined")
  end; else
    do forever
      parse var Mailinglists ListName "," ListAddr '0A'x Mailinglists
      ListName = strip(ListName); ListAddr = strip(ListAddr)
      if ListName = '' then leave;
      call Export ListName ListAddr
    end
end;

/*** Final cleanup ***/

BREAK_C:
BREAK_D:
BREAK_E:
BREAK_F:
ERROR:
HALT:
IOERR:
SYNTAX:

IF RC ~= 0 THEN DO
  SAY "Error: " rc errortext(rc) "Line" sigl
END

/*** Logout ***/

if account ~= 0 then do
  call UMSLogout(account)
  account = 0
end

exit

/*** Check for new messages from the server ***/

Import: PROCEDURE expose account GroupPrefix TRUE FLAGS.,
                         UMSUSTAT. UMSCODE_Group UMSCODE_FromName UMSCODE_ToName,
                         UMSCODE_ToAddr UMSCODE_ReplyName UMSCODE_ReplyAddr,
                         UMSCODE_MsgID UMSCODE_Attributes UMSCODE_RefID,
                         Mailinglists Name ProgramName Name UMSNUMFIELDS

  say "Moving messages from all lists into groups..."

  match = MakeFlags(UMSUSTAT.ReadAccess)
  mask  = MakeFlags(UMSUSTAT.ReadAccess, UMSUSTAT.Old)

  call UMSSelectField(account, "L", MakeFlags(0), MakeFlags(),,, UMSCODE_Group, "", true)
  call UMSSelectFlags(account, "L", MakeFlags(1), MakeFlags(),,, "U", mask, match)

  last = 0; numMsgs = 0;
  do forever
    last = UMSSearchFlags(account, "L", FLAGS.01, FLAGS.01, last)
    if last = 0 then leave

    if ReadUMSMsgField(account,last,msg.,UMSCODE_ReplyName,true) then do
      parse var msg.UMSCODE_ReplyName test "'" listname "'"
      if (upper(test) = "MAILINGLIST ") & (listname ~= "") then do

        if ~ReadUMSMsgAll(account, last, msg., true) then do
          call CheckErr
        end

        /*** check ref-IDs ***/
        if ReadUMSMsgInfo(account, last, msg.) & (msg.up ~= 0) then do
          drop repmsg.
          if ReadUMSMsgField(account, msg.up, repmsg., UMSCODE_Attributes) then do
            parse var repmsg.UMSCODE_Attributes "oid<" mailref ">"
            msg.UMSCODE_RefID = mailref
          end
        end

        /* insert into config var, if not already there */
        call CheckEntry(listname,msg.UMSCODE_ReplyAddr)

        call UMSSelectMsg(account,"U", MakeFlags(UMSUSTAT.Old), MakeFlags(), last)

        msg.UMSCODE_Group = GroupPrefix || listname
        msg.UMSCODE_Attributes = "oid<" || msg.UMSCODE_MsgID || "> "
        drop msg.UMSCODE_MsgID msg.UMSCODE_ToName msg.UMSCODE_ToAddr
        drop msg.UMSCODE_ReplyName msg.UMSCODE_ReplyAddr msg.UMSCODE_Folder

        num = WriteUMSMsg(account, msg.)
        /*say num*/
        if num = 0 then do
          call CheckErr
        end; else do
          numMsgs = numMsgs + 1;
          call log(7,"forwarded message written by '" || msg.UMSCODE_FromName ||,
                     "' to '" || msg.UMSCODE_Group || "'")
        end

        drop msg.
      end;
    end
  end
  call log(5,"imported" numMsgs "messages");
return

/*** Check for new messages from the users ***/

Export: PROCEDURE Expose account GroupPrefix TRUE FLAGS.,
                         UMSUSTAT. UMSCODE_Group UMSCODE_FromName UMSCODE_FromAddr,
                         UMSCODE_ToName UMSCODE_ToAddr UMSCODE_ReplyName,
                         UMSCODE_ReplyAddr UMSCODE_MsgID UMSCODE_Attributes,
                         UMSCODE_RefID UMSNUMFIELDS

  parse arg listname listaddr .

  groupname = GroupPrefix || listname
  match = MakeFlags(UMSUSTAT.ReadAccess)
  mask  = MakeFlags(UMSUSTAT.ReadAccess, UMSUSTAT.Old)

  call UMSSelectField(account, "L", MakeFlags(0), MakeFlags(),,, UMSCODE_Group, groupname, true)
  call UMSSelectField(account, "L", MakeFlags(1), MakeFlags(),,, UMSCODE_FromAddr, "", true)
  call UMSSelectFlags(account, "L", MakeFlags(2), MakeFlags(),,, "USER", mask, match)

  last = 0; numMsgs = 0;
  do forever
    last = UMSSearchFlags(account, "L", FLAGS.012, FLAGS.012, last)
    if last = 0 then leave
    if ~ReadUMSMsgAll(account, last, msg.) then do
      call CheckErr
    end

    /*** check ref-IDs ***/
    if ReadUMSMsgInfo(account, last, msg.) & (msg.up ~= 0) then do
      drop repmsg.
      if ReadUMSMsgField(account, msg.up, repmsg., UMSCODE_Attributes) then do
        parse var repmsg.UMSCODE_Attributes "oid<" mailref ">"
        msg.UMSCODE_RefID = mailref
      end
    end

    drop msg.UMSCODE_Group

    msg.UMSCODE_ToName = "Mailinglist '" || listname || "'"
    if listaddr ~= "" then
      msg.UMSCODE_ToAddr = listaddr
    else
      drop msg.UMSCODE_ToAddr

    msg.UMSCODE_Attributes = "oid<" || msg.UMSCODE_MsgID || "> "
    drop msg.UMSCODE_MsgID

    num = WriteUMSMsg(account, msg.)
    say num
    if num = 0 then do
      call CheckErr
    end; else do
      numMsgs = numMsgs + 1;
      call log(7,"forwarded message written by '" || msg.UMSCODE_FromName ||,
                 "' from '" || groupname || "'")
    end

    drop msg.
  end
  call log(5,"exported" numMsgs "messages to list '" || listname || "'),
return

/*** check if mailinglist is in our list ***/

CheckEntry:
  listname=arg(1); addr=arg(2);

  ml = Mailinglists
  do forever
    parse var ml LName "," LAddr '0A'x ml
    LName = strip(LName); LAddr = strip(LAddr)
    if upper(LName) = upper(listname) then do
       /* todo? update address */
      return FALSE
    end; else if ml = '' then do
      if Mailinglists = '' then
        Mailinglists = listname "," addr
      else
        Mailinglists = Mailinglists || '0A'x || listname "," addr
      if ~ WriteUMSConfig(account, ProgramName || ".Mailinglists", Mailinglists, Name) then
        call CheckErr()
      return TRUE
    end
  end

/*** Show a message for debugging ***/

ShowMsg:
  do field = 0 to UMSNUMFIELDS
    if (symbol("msg." || field) = "VAR") & (field ~= UMSCODE_MsgText) & (field ~= UMSCODE_Comments) then do
      say "Field #" || field || ": '" || msg.field || "'"
    end
  end
return

/*** Support ***/

log: PROCEDURE expose account debugLevel
  level=arg(1); text=arg(2)
  if level <= debugLevel then say text
  call LogUMS(account, level, text)
return 0

CheckErr: PROCEDURE expose account
  err = UMSErrNum(account)
  if err ~= 0 then do
    log (3,"UMS Error #" || err || ": " || UMSErrTxt(account))
  end return