Super Net 1/SUPERNET_1.iso/PC/OTROS/EXTRAS/UUCODE/UUCP/UUPOST10.ZIP/uupcpost.pas

Pascal/Delphi Source File | 1994-04-24 | 6.0 KB | 259 lines

{$M 8192, 0, 0}
program uupc_post_news;

{
  Posting module for UUPC/Extended. This program implements posting of
  newsgroups using UUPC/Extended's UUCP- and RNEWS-programs.

  All articles are posted to the Mailserv host using UUCP, as RNEWS
  (at least up till version 1.12i) does not handle outgoing news.

  A local copy of the article is created in the news database, using
  RNEWS to process the article file and store it in the local database.

  Note: This program assumes that you are running UUPC in its default
  news-batching mode. If you have the 'snews' option set in UUPC.RC,
  this program will not be able to store a local copy of the article,
  although posting of the article to your newsfeed will work.

  Written by Henrik Storner ([e-mail]).

Credits:

  Russell Schulz, for his Rusnews program which made me hack this to-
  gether, so that I could use his Rusnews newsreader instead of the
  very simplistic Snews program. Also, credit goes to Russ for getting
  me to implement this as a standalone program. The 'indir' and 'execp'
  routines herein were taken from the Rusnews sources.

  The authors of SNews, who came up with the scheme for posting using
  only UUCP, which is used in this program.
}

uses dos;

var
  { These vars are read from the UUPC config files }
  userdir, temporarydir, newsname, smarthost: string;

  { These are local vars }
  seqfile, tmp: text;
  seq: integer; seqstr: string;
  i: integer;
  d_name, x_name, short_x_name: string;
  uucp_args: string;


procedure loadconfig;

{
  Load the UUPC configuration. We need the following entries from
  the file referenced by UUPCSYSRC:
  - Tempdir   -> temporarydir
  - Nodename  -> newsname
  - Mailserv  -> smarthost

  Userdir is set to the UUPC main directory, i.e. the directory for
  the UUPCSYSRC file.
}

var
    uupcsysrcfn : string;
    t1, t2: string;
    sysf: text;

begin
uupcsysrcfn:= GetEnv('UUPCSYSRC');
if (uupcsysrcfn = '') then
   begin
   writeln('UUPCSYSRC not set - aborting.');
   halt(2);
   end;

FSplit(uupcsysrcfn, userdir, t1, t2);
if (userdir[length(userdir)] = '\') then
   delete(userdir, length(userdir), 1);

assign(sysf, uupcsysrcfn);
{$I-}
reset(sysf);
{$I+}
if (ioresult <> 0) then
   begin
   writeln('Cannot open UUPCSYSRC file (', uupcsysrcfn, ')');
   halt(2);
   end;

temporarydir:= '';
newsname:= '';
smarthost:= '';

while not eof(sysf) do
   begin
   readln(sysf, t1);
   if (t1 <> '') then
      begin
      while (t1[1] in [' ', #9]) do
         delete(t1, 1, 1);

      t2:= t1;
      for i:= 1 to length(t1) do
          t1[i]:= UpCase(t1[i]);

      if (t1[1] <> '#') then
         begin
         if (pos('TEMPDIR', t1) = 1) then
        temporarydir:= copy(t2, pos('=', t2)+1, 255);
         if (pos('NODENAME', t1) = 1) then
        newsname:= copy(t2, pos('=', t2)+1, 255);
     if (pos('MAILSERV', t1) = 1) then
        smarthost:= copy(t2, pos('=', t2)+1, 255);
         end;
      end;
   end;

close(sysf);

if (temporarydir = '') or (newsname = '') or (smarthost = '') then
   begin
   writeln('Cannot read config from UUPCSYSRC file');
   writeln('tempdir = ', temporarydir);
   writeln('nodename = ', newsname);
   writeln('mailserv = ', smarthost);
   halt(2);
   end;
end;



function indir(filespec,dir: string): boolean;
var
  fileinfo: searchrec;

begin
  findfirst(dir+'\'+filespec,archive,fileinfo);
  indir := (doserror=0);
end;


procedure execp(cmd, cmdline: string);
var
  path: string;
  success: boolean;
  el: string;
  at: integer;

begin
  if (pos(':',cmd)<>0) or (pos('\',cmd)<>0) then
    exec(cmd,cmdline)
  else if indir(cmd,'.') then
    exec(cmd,cmdline)
  else
    begin
      path := getenv('PATH');
      success := false;
      while not success and (path<>'') do
        begin
          if copy(path,length(path),255)<>';' then
            path := path+';';
          at := pos(';',path);
          el := copy(path,1,at-1);
          path := copy(path,at+1,255);
          if indir(cmd,el) then
            begin
              success := true;
              exec(el+'\'+cmd,cmdline);
            end;
        end;
    end;
end;


procedure uupc_post(articlefn: string);
const
  hexchars : string[16] = '0123456789abcdef';

begin

{ Get a sequence number for the D. and X. files }
assign(seqfile, userdir+'\nseq');
{$I-}
reset(seqfile);
if ioresult<>0 then
   begin
   { Sequence file not found }
   seq:= 0;
   end
else
   begin
   readln(seqfile, seq);
   if ioresult<>0 then seq:= 0;
   close(seqfile);
   end;
seq:= seq+1;
rewrite(seqfile);
if ioresult=0 then
   writeln(seqfile, seq)
else
   { Do some error handling }
   ;
close(seqfile);
{$I+}

{ Get it in 4-digit hex }
seqstr:= '';
for i:= 1 to 4 do
   begin
   seqstr:= hexchars[1+(seq mod 16)] + seqstr;
   seq:= seq div 16;
   end;

d_name:= 'D.' + newsname + seqstr;
x_name:= 'X.' + newsname + seqstr;
short_x_name:= temporarydir + '\X_' + seqstr + '.' + copy(newsname, 1, 3);

assign(tmp, short_x_name); rewrite(tmp);
writeln(tmp, 'U news ', newsname);
writeln(tmp, 'Z');
writeln(tmp, 'F ', d_name);
writeln(tmp, 'I ', d_name);
writeln(tmp, 'C rnews');
close(tmp);

uucp_args:= '-C ' + articlefn + ' ' + smarthost + '!' + d_name;
execp('uucp.exe', uucp_args);
uucp_args:= '-C ' + short_x_name + ' ' + smarthost + '!' + x_name;
execp('uucp.exe', uucp_args);

assign(tmp, short_x_name); erase(tmp);

{ Post the article locally. For this, rnews works! }
uucp_args:= '-f ' + articlefn;
execp('rnews.exe', uucp_args);

end;


begin
writeln('UUPCpost 1.0');
if (paramcount <> 1) then
   begin
   writeln('Usage: uupcpost infile');
   halt(1)
   end;

{ Check that the file exists }
assign(tmp, paramstr(1));
{$I-} reset(tmp); {$I+}
if (ioresult <> 0) then
   begin
   writeln('Cannot read file ', paramstr(1));
   halt(1);
   end;

loadconfig;
uupc_post(paramstr(1));
halt(0);
end.