--- doc/loncapafiles/sanitycheck.piml	2003/01/07 21:12:54	1.12
+++ doc/loncapafiles/sanitycheck.piml	2020/01/04 18:03:16	1.47
@@ -1,9 +1,8 @@
 <!DOCTYPE piml PUBLIC "-//TUX/DTD piml 1.0 Final//EN" 
 	"http://lpml.sourceforge.net/DTD/piml.dtd">
 <!-- sanitycheck.piml -->
-<!-- Scott Harrison -->
 
-<!-- $Id: sanitycheck.piml,v 1.12 2003/01/07 21:12:54 harris41 Exp $ -->
+<!-- $Id: sanitycheck.piml,v 1.47 2020/01/04 18:03:16 raeburn Exp $ -->
 
 <!--
 
@@ -61,12 +60,15 @@ else
 </file>
 <file>
 <target dist='default'>/var/lib/mysql/mysql.sock</target>
+<target dist='suse11.2 suse11.3 suse11.4 suse12.1 suse12.2 suse12.3 suse13.1 suse13.2 sles12 sles15'>/var/run/mysql/mysql.sock</target>
+<target dist='debian5 debian6 ubuntu6 ubuntu8 ubuntu10 ubuntu12 ubuntu14 ubuntu16 ubuntu18 ubuntu20'>/var/run/mysqld/mysqld.sock</target>
 <perlscript mode='fg'>
 unless
     (-e '<TARGET />') # Does file exist?
   {
     print("**** ERROR **** Missing <TARGET />\n");
   }
+<!-- Commented out by Matthew since MySQL insists on doing things its own way
 else # It exists, so look at the file metadata more closely.
   {
     my @s = stat('<TARGET />');
@@ -77,7 +79,7 @@ else # It exists, so look at the file me
 
     if ($uid ne $web_uid) # If file owned by someone else other than www.
       {
-	print('**** ERROR **** <TARGET /> should be owned by'.
+	print('**** WARNING **** <TARGET /> should be owned by'.
 	      ' www.'."\n".'Try these commands to make things right:'."\n".
 	      'chown www:www <TARGET />'."\n".
 	      'chmod a-rwx,u+rwx <TARGET />'."\n");
@@ -88,7 +90,7 @@ else # It exists, so look at the file me
 	my $wflag = $1;
 	if ($wflag != 7) # Can www use this socket?  (Hope so!)
 	  {
-	    print('**** ERROR **** '.
+	    print('**** WARNING **** '.
 	      '<TARGET /> should be user "rwx" (by'.
 	      ' www).'."\n".'Try these commands to make things right:'."\n".
 	      'chown www:www <TARGET />'."\n".
@@ -98,7 +100,7 @@ else # It exists, so look at the file me
 	$wflag=$1;
 	if ($wflag ne "00") # Can others use this socket?  (Hope not!)
 	  {
-	    print('**** ERROR **** '.
+	    print('**** WARNING **** '.
 	      '<TARGET /> should not be group or everybody accessible'.
 	      '.'."\n".'Try these commands to make things right:'."\n".
 	      'chown www:www <TARGET />'."\n".
@@ -106,10 +108,12 @@ else # It exists, so look at the file me
 	  }
       }
   }
+ -->
 </perlscript>
 </file>
 <file>
 <target dist='default'>/etc/httpd/conf/loncapa.conf</target>
+<target dist='sles10 sles11 sles12 sles15 suse10.1 suse10.2 suse10.3 suse11.1 suse11.2 suse11.3 suse11.4 suse12.1 suse12.2 suse12.3 suse13.1 suse13.2 debian5 debian6 ubuntu6 ubuntu8 ubuntu10 ubuntu12 ubuntu14 ubuntu16 ubuntu18 ubuntu20'>/etc/apache2/loncapa.conf</target>
 <perlscript mode='fg'>
 open IN, "&lt;<TARGET />";
 my $hbug=-1;
@@ -118,14 +122,14 @@ while (&lt;IN&gt;) {
  if (/PerlSetVar\s+lonHostID\s+(\S+)/) {
   my $v=$1;
   $hbug=0;
-  $hbug=1 if $v=~/\W/;
-  $hbug=1 if $v=~/\_/;
+  $hbug=1 if $v=~/[^\w.\-]/;
+  $hbug=1 if $v=~/_/;
  }
  if (/PerlSetVar\s+lonDefDomain\s+(\S+)/) {
   my $v=$1;
   $dbug=0;
-  $dbug=1 if $v=~/\W/;
-  $dbug=1 if $v=~/\_/;
+  $dbug=1 if $v=~/[^\w.\-]/;
+  $dbug=1 if $v=~/_/;
   # Avoid namespace conflicts under the web server's DocumentRoot.
   my @badnames=('raw','userfiles','priv','adm','uploaded');
   foreach my $bad (@badnames) {
@@ -148,37 +152,47 @@ my $rbug=0;
 my $dbug=0;
 my $sbug=0;
 my $fbug=0;
-while (&lt;IN&gt;) {
- next if (/^(\#|\s*$)/);
- if (/\S/) {
-  $rbug=1 if /\r/;
-  my @a=split(/\:/,$_);
-  $dbug=1 if $a[0]=~/\W/;
-  $dbug=1 if $a[0]=~/\_/;
-  $dbug=1 if $a[1]=~/\_/;
-  $dbug=1 if $a[1]=~/\W/;
-  $fbug=1 if (@a<5 || @a>6);
+my %line;
+my $line=0;
+while (my $l = &lt;IN&gt;) {
+ $line++;
+ next if ($l=~/^(\#|\s*$)/);
+ if ($l=~/^\^/) {
+  if ($l !~ /^\^[\w.\-]/) {
+    $dns_bug = 1;
+    push(@{$line{'dns'}},$line);
+  }
+ } elsif ($l=~/\S/) {
+  if ($l=~/\r/) {              $rbug=1; push(@{$line{'r'}},$line); }
+  my @a=split(/:/,$l);
+  if ($a[0]=~/[^\w\-.]/ ||
+      $a[1]=~/[^\w\-.]/ ||
+      $a[0]=~/\_/       ||
+      $a[1]=~/\_/      ) { $dbug=1; push(@{$line{'d'}},$line); }
+  if (@a<6 || @a>6) {      $fbug=1; push(@{$line{'f'}},$line); }
   my $expr='\s.+$';
-  $sbug=1 if ($a[0] =~ /$expr/ ||
-	      $a[1] =~ /$expr/ ||
-	      $a[2] =~ /$expr/ ||
-	      $a[3] =~ /$expr/ ||
-	      $a[4] =~ /$expr/ )
+  if ($a[0] =~ /$expr/ ||
+      $a[1] =~ /$expr/ ||
+      $a[2] =~ /$expr/ ||
+      $a[3] =~ /$expr/ ) { $sbug=1; push(@{$line{'s'}},$line); }
 ;
  }
 }
 close IN;
 if ($rbug) {
-  print "**** ERROR **** <TARGET /> is DOS-formatted\n";
+  print "**** ERROR **** <TARGET /> is DOS-formatted (lines ".join(', ',@{$line{'r'}}).")\n";
 }
 if ($dbug) {
-  print "**** ERROR **** <TARGET /> has invalid host id or domain id\n";
+  print "**** ERROR **** <TARGET /> has invalid host id or domain id (lines ".join(', ',@{$line{'d'}}).")\n";
 }
 if ($fbug) {
-  print "**** ERROR **** <TARGET /> is lacking 5 or 6 columns for every row\n";
+  print "**** ERROR **** <TARGET /> is lacking 6 columns for every row (lines ".join(', ',@{$line{'f'}}).")\n";
 }
 if ($sbug) {
-  print "**** ERROR **** <TARGET /> has illegal whitespace character\n";
+  print "**** ERROR **** <TARGET /> has illegal whitespace character (lines ".join(', ',@{$line{'s'}}).")\n";
+}
+if ($dns_bug) {
+  print "**** ERROR **** <TARGET /> host.tab server entry has characters (lines ".join(', ',@{$line{'dns'}}).")\n";
 }
 </file>
 <file>
@@ -187,12 +201,14 @@ open IN, "&lt;<TARGET />";
 my $rbug=0;
 my $dbug=0;
 my $sbug=0;
-while (&lt;IN&gt;) {
- if (/\S/) {
-  $rbug=1 if /\r/;
-  $dbug=1 if $_=~/\W.*\n$/;
-  $dbug=1 if $_=~/\_/;
-  $sbug=1 if /\s.+$/;
+while (my $line = &lt;IN&gt;) {
+ if ($line =~ /\S/) {
+  $rbug=1 if $line=~/\r/;
+  if ($line =~ /\W.*\n/) {
+	$dbug=$line if ($line !~/\w:(?:primary|default)$/);
+  }
+  $dbug=$line if $line=~/\_/;
+  $sbug=1 if $line=~/\s.+$/;
  }
 }
 close IN;
@@ -200,7 +216,7 @@ if ($rbug) {
   print "**** ERROR **** <TARGET /> is DOS-formatted\n";
 }
 if ($dbug) {
-  print "**** ERROR **** <TARGET /> has invalid host id\n";
+  print "**** ERROR **** <TARGET /> has invalid host id ($dbug)\n";
 }
 if ($sbug) {
   print "**** ERROR **** <TARGET /> has illegal whitespace character\n";