1@echo off
2perl -x %0.bat
3goto myexit
4#!perl
5extproc perl -x
6eval 'exec @PERLPATH@ -S $0 ${1+"$@"}'
7    if 0 ;
8#! @PERLPATH@
9# (this is a perl script: it requires a perl interpreter)
10# atpdiag -- diagnostic 'lint' for atprc (the atp configuration file).
11$diagversion = "0.92" ;
12
13# set up associative array of critical atprc values
14
15%rcvals = (
16'mail', '',
17'reply', '',
18'workpath', '',
19'editor', '',
20'archiver', '',
21'unarchiver', '',
22'speller', '',
23) ;
24
25%rcflag = (
26'mail', '',
27'reply', '',
28'workpath', '',
29'editor', '',
30'archiver', '',
31'unarchiver', '',
32'speller', '',
33) ;
34
35%rcbool = (
36'ansi', 'on ',
37'autotag','on ',
38'bell','off ',		# silent:read.c
39'color','on ',		# color:read.c
40'graphics','on ',
41'header','on ',
42'pcb','on ',		# pcbext:read.c
43) ;
44
45# get options
46
47$opt_v =  '' ;
48$opt_h == '' ;
49
50foreach $i (0 .. $#ARGV)
51{
52	$goodopt = '';
53	$curopt = $ARGV[$i] ;
54	$curopt =~ /^-{1,2}[vV]e*/ && ( $opt_v = 't' ) && ( $goodopt = 't' );
55	$curopt =~ /^-{1,2}[hH]e*/ && ( $opt_h = 't' ) && ( $goodopt = 't' );
56	if ( ! $goodopt )
57	{
58	  printf "unrecognized option: %s\n", $ARGV[$i] ;
59	  exit 1 ;
60	} ;
61}
62
63if ( $opt_v && ! $opt_h ) { printf "%s\n", $diagversion ; exit 0 ; }  ;
64
65# print banner
66print "\n\n\n" ;
67print  "    +---------------------------------------------+\n";
68printf "    |  ATP QWK Mail/News Reader Diagnostics %s  |\n", $diagversion ;
69print  "    +---------------------------------------------+\n\n";
70
71if ( $opt_h ) { print "    Usage:  atpdiag [ -h | -v ] \n\n" ; exit 0 ; } ;
72
73# get PATH from environment
74$paths = $ENV{ 'PATH' } ;
75$paths =~ tr%A-Z\\%a-z/% ; # @NOTUX@
76@pdirs = reverse split( /;/, $paths ) ; # @NOTUX@
77@pdirs = reverse split( /:/, $paths ) ; # @UNIX@
78
79# get ATP home directory
80$atpath = $ENV{ 'ATP' } ;
81if ( ! $atpath )
82{
83     print  "  - WARNING: you have not set and/or exported the ATP environment variable!\n" ;
84     $atpath = $ENV{ 'HOME' } ;
85     printf "  - INFO   : looking in your 'HOME' %s directory for atprc\n", $atpath ;
86}
87
88# make sure atpath ends in '/' but not '//'
89$atpath =~ s/\/+\s*$//  ;
90$atpath =~ s/$/\//  ;
91
92# check existance of atprc initialization file
93if ( -e  $atpath.".atprc" )
94  { $rcpath = $atpath.".atprc" }
95elsif ( -e $atpath."atprc" )
96  { $rcpath = $atpath."atprc" }
97else
98  {
99  printf "  - ERROR  : Can't find atprc or .atprc on path %s \n", $atpath ;
100  printf "    please verify and try again!\n\n" ;
101  exit 1 ;
102  }
103
104# find where atp executable is
105  $found = $canrun = '' ;
106  foreach $dir ( @pdirs )
107  {
108    if ( -e $dir."/atp" )
109    {
110      $found = $dir."/atp" ;
111      if ( -x  $found )
112      { $canrun = 't' ; }
113      else
114      { $canrun = ''  ; } ;
115    }
116  }
117
118# display informational messages
119$atpath =~ tr%A-Z\\%a-z/% ; # @NOTUX@
120$rcpath =~ tr%A-Z\\%a-z/% ; # @NOTUX@
121$found  =~ tr%A-Z\\%a-z/% ; # @NOTUX@
122printf "  - INFO   : ATP home base is: %s\n", $atpath ;
123printf "  - INFO   : ATP atprc file is: %s\n", $rcpath ;
124if ( $found )
125{
126  printf "  - INFO   : ATP atp exec file is: %s\n", $found ;
127  if ( ! $canrun )
128  {
129    printf "\n  - WARNING: no execute permission for %s \n", $found ;
130  }
131  else
132  {
133    print "\n" ;
134  }
135}
136else
137{
138  print "\n" ;
139}
140
141# check existance and readability of taglines.atp
142if ( -e $atpath."taglines.atp" )
143 {
144  if ( ! open( TAGLINES, $atpath."taglines.atp" ) ) {
145  printf "  - WARNING: can't open file %s \n", $atpath."taglines.atp" ;
146  printf "    please verify and check permissions.\n" ; }
147  else { close TAGLINES } ;
148 }
149else
150 {
151  printf "  - WARNING: can't find file 'taglines.atp' in %s\n", $atpath ;
152 }
153
154# try to open atprc
155if ( ! open( ATPRC, $rcpath ))
156{
157printf "%3d ERROR  : can't open your atprc %s\n", $atrcln, $rcpath ;
158printf "    Please verify, check permissions, and try again.\n" ;
159exit 1 ;
160}
161
162# Read and parse each line of atprc with emphasis on paths and executables
163$atprcln = 0 ;
164while (<ATPRC>)
165{
166  $atprcln = $atprcln + 1 ;
167  chop;
168#  #s/^\s+//; # strip leading white space
169#  s/\s+#+.*$//; # strip trailing comments and white space
170
171# check for proper alignment
172  if ( /^#|^\s*$/ )
173  {
174     goto endo ;
175  }
176  elsif ( /^\s+#/ )
177  {
178     printf "\%3d ERROR  : comments must be left justified\n", $atprcln ;
179     goto endo ;
180  }
181  elsif ( /^\s+\S*/ )
182  {
183     printf "%3d ERROR  : entries must be left justified\n", $atprcln ;
184  }
185
186# if needed correct alignment errors
187   s/^\s+//; # strip leading white space
188   # [future use]  s/\s+#+.*$//; # strip trailing comments and white space
189
190# check critical ATP paths
191  if ( /^(mail|reply|workpath)\s+/ ) # paths
192  {
193     $pathtype = $1 ;
194     /$pathtype\s+=\s+(\S+)\s*(.*)/ ;
195     $pathway = $1 ; $pathjunk = $2 ;
196     if ( ! $pathway ) { goto endo ; }
197     else { $rcvals{ $pathtype } = 't'; }
198     if ( $pathjunk )
199     {
200     	printf ("%3d WARNING: junk follows %s path definition %s:   %s\n",
201	        $atprcln, $pathtype, $pathway, $pathjunk ) ;
202     }
203     if ( ! -e $pathway )
204     {
205     	printf ("%3d WARNING: %s path doesn't exist: %s\n", $atprcln, $pathtype, $pathway ) ;
206	goto endo ;
207     }
208     if ( ! -d _ )
209     {
210     	printf "%3d WARNING: %s path: %s is not a directory.\n", $atprcln, $pathtype, $pathway ;
211	goto endo ;
212     }
213     if ( ! -r _ )
214     {
215     	printf "%3d WARNING: %s path: %s is not readable.\n", $atprcln, $pathtype, $pathway ;
216     }
217     if ( ! -w $pathway )
218     {
219     	printf "%3d WARNING: %s path: %s is not writable.\n", $atprcln, $pathtype, $pathway ;
220     }
221     if ( ! -x $pathway )
222     {
223     	printf "%3d WARNING: can't change to %s directory: %s\n", $atprcln, $pathtype, $pathway ;
224     }
225
226  }
227# check PATH for critical executables needed by ATP:
228  elsif ( /^(editor|unarchiver|archiver|speller)\s+/ ) # bins
229  {
230       $cmdtype = $1 ;
231       /$cmdtype\s+=\s+(\S+)\s*(.*)/ ;
232       $cmdexec = $1 ; $cmdflag = $2 ;
233       # debug code
234       #printf "\t%s | %s | %s \n", $cmdtype, $cmdexec, $cmdflag ;
235       if ( ! $cmdexec ) { goto endo ; }
236       if ( $rcvals{ $cmdtype } )
237         { printf "%3d WARNING: atprc variable \'%s\' redefined\n", $atprcln, $cmdtype }
238       $rcvals{ $cmdtype } = $cmdexec ;
239       $rcflag{ $cmdtype } = $cmdflag ;
240       $found = '' ; $canrun = '' ;
241
242# check if command is absolute path
243if ( grep( /^\//, $cmdexec )) {           # @UNIX@
244if ( grep( /^[A-Ma-m]:\\/, $cmdexec )) {  # @NOTUX@
245  @srchpath = ("") ;
246  $sep = "" ;
247} else {
248  @srchpath = @pdirs ;
249  $sep = "/" ;
250} ;
251
252@sfxlst = ("") ;
253if(!grep(/\.(cmd|exe)$/i,$cmdexec)){@sfxlst=("\.exe","\.cmd");}; # @OS2@ @NOTUX@
254if(!grep(/\.(com|exe|bat)$/i, $cmdexec)){@sfxlst=("\.com","\.exe","\.bat");}; # @DOS@ @NOTUX@
255foreach $dir ( @srchpath ) {
256foreach $sfx ( @sfxlst   ) {
257  $tstmp = $dir.$sep.$cmdexec.$sfx ;
258     if ( -e $tstmp )
259     {
260        $found = $tstmp ;
261        if ( -x $found )
262	  { $canrun = "t" } else { $canrun = '' ; } ;
263     }
264   }
265 }
266      if ( ! $found )
267        {
268	printf "%3d WARNING: can't find %s %s in your exec PATH\n", $atprcln, $cmdtype, $cmdexec ;
269	$rcvals{ $cmdtype } = "ERROR: line ".$atprcln ;
270	}
271      elsif ( ! $canrun )
272        {
273	printf "%3d WARNING: no execute permission for %s %s\n", $atprcln, $cmdtype, $found ;
274	}
275    }
276
277# check for configuration options which take numeric arguments
278    elsif ( /^(screencol|screenlen|truncate)\s+=\s+(\d+|\S*)\s*(\S*)/ ) # numerical
279    {
280       if ( $3 )
281       { printf "%3d WARNING: junk follows %s numeric definition: %s\n",
282         $atprcln, $1, $3 ; }    ;
283       if ( ! grep( /^\d+$/, $2 ) || $2 < 0 )
284       { printf "%3d WARNING: bad numeric argument for %s: %s\n",
285         $atprcln, $1, $2 ;
286       } ;
287    }
288
289# check for options which take string arguments
290    elsif ( /^(blist|charset|qlist|tagline|tagstyle|user)/i ) #string
291    {
292     ;
293    }
294
295# check for options which take on/off boolean arguments
296    elsif ( /^(ansi|autotag|bell|color|graphics|header|pcb)\s+=/i ) # boolean
297    {
298       $booltype = $1 ;
299       $boolflag = $rcbool{ $1 } ;
300     if ( /$booltype\s+=\s+(on|off|\S+)\s*(\S*)/ )
301     {
302        # check for trailing junk
303        if ( $2 )
304        {
305         printf "%3d WARNING: junk follows %s boolean (on|off) definition: %s\n",
306         $atprcln, $booltype, $2 ;
307        }
308
309        # check for non-boolean argument
310        if ( ($1 ne "on") && ($1 ne "off") )
311        {
312	 printf "%3d WARNING: bad boolean (on|off) argument for %s: %s\n",
313         $atprcln, $booltype, $1 ;
314        } ;
315
316	# check if variable was previously defined
317	if((! grep(/o(n|ff) /, $boolflag)))
318	{
319         printf "%3d WARNING: atprc boolean variable \'%s\' redefined\n",
320	 $atprcln, $booltype ;
321	}
322	$rcbool{ $booltype } = $1 ;
323     }
324     else
325     {
326      printf "%3d WARNING: atprc variable \'%s\' NOT initialized\n",
327      $atprcln, $booltype ;
328     } ;
329    }
330    else
331    {
332       printf "%3d WARNING: unrecognized entry\n", $atprcln ;
333    }
334endo:
335}
336close ATPRC ;
337
338# list important atprc variables which were not assigned during parse.
339foreach $val ( 'mail','reply','workpath','editor',
340               'archiver','unarchiver','speller' )
341{
342  if ( ! $rcvals{ $val } )
343  {
344    printf "  - WARNING: atprc variable \'%s\' NOT initialized\n", $val ;
345  }
346}
347
348# check if unarchiver is UnZip 5.11 or later and should use -L switch
349$unarch = $rcvals{ "unarchiver" } ;
350$unflag = $rcflag{ "unarchiver" } ;
351$unzenv = $ENV{ UNZIP } ;
352
353if ( grep( /unzip/ , $unarch ))
354{
355$unzversion = "" ;
356$lswitch = "" ;
357
358$_ = `$unarch 9-_df-_e.zip 2>&1` ; # hopefully this is a unique file name :-)
359s/\n/ /g ;
360if ( /pkunzip/i ) { printf "\n" ; exit 0 ; } ;
361$_ = `$unarch -h 2>&1` ; #
362s/\n/ /g ;
363/UnZip\s+(\d+\.\d+)\s/ && ( $unzversion = $1 ) ;
364/\s-(L)\s.*[lL]ower/   && ( $lswitch = "L" ) ;
365
366  if (    (  $lswitch eq "L" )
367       &&(( ! grep( /-.*L/ , $unzenv ))
368       && ( ! grep( /-.*L/ , $unflag )) )
369     )
370  {
371    printf "  - WARNING: UnZip %s -- you must add -L switch to %s flags in\n", $unzversion, $unarch ;
372    printf "    atprc or add -L switch to flags in UNZIP environment variable\n" ;
373    if( ! $unzenv )
374    { print "    which currently is either not set or not exported.\n" ; } ;
375  }
376}
377
378# end of file
379__END__
380:myexit
381