#!%PERL%
#
# ruboard %VERSION% common subroutines
#
# Copyright (c) 1998 by Andrew Maltsev, <am@amsoft.ru>
#
# $Id: rublib.PL,v 1.19 1999/03/10 10:40:26 am Exp $
#
# To alter supported languages search for @LANG@. Only russian and
# english languages supported now.
###############################################################################
#
# Home directory
#
$homedir = "%HOMEDIR%";

###############################################################################
# Reading configuration. If we have `config' form parameter defined,
# then search for configuration file is done in following order:
#  1) $homedir/$config.cf
#  2) $homedir/$config/ruboard.cf
#  3) $homedir/ruboard.cf
# Only first word (as \w specifies) from `config' used.
#
sub read_config
{ undef $cf_file;
  if($FORM{"config"})
   { $FORM{"config"} =~ /^\s*(\w+).*$/;
     $config=$1;
     if($config)
      { if(-r "$homedir/$config.cf")
         { $cf_file="$homedir/$config.cf";
         }
        else
         { $cf_file="$homedir/$config/ruboard.cf";
           $basedir=$config;
           undef $cf_file unless -r $cf_file;
         }
      }
   }
  $cf_file="$homedir/ruboard.cf" unless $cf_file;

  # Setting defaults
  #
  $basedir=$config;
  $title="ruboard v%VERSION%";
  $cgi_url="http://" . $ENV{"HTTP_HOST"} . $ENV{"SCRIPT_NAME"};
  $admin_url="http://" . $ENV{"HTTP_HOST"} . $ENV{"SCRIPT_NAME"};
  if($cgi_url =~ /ruboard/)
   { split("/",$admin_url);
     $_[@_-1]=~s/ruboard/rubadmin/;
     $admin_url=join("/",@_);
   }
  elsif($admin_url =~ /rubadmin/)
   { split("/",$cgi_url);
     $_[@_-1]=~s/rubadmin/ruboard/;
     $cgi_url=join("/",@_);
   }
  $mesgdir="messages";
  $datafile="msgseq.dat";
  $passwd_file="passwd.dat";
  $ext="html";
  $mainpage="";
  $faqfile="";
  $language="english";
  $show_faq=0;
  $show_refs=1;
  $allow_html=0;
  $quote_text=1;
  $subject_line=0;
  $use_time=1;
  $bg_paper="#FFFFFF";		# Common background
  $bg_image="";			# Background image
  $bg_subject="#CCCCCC";	# Color of Subject line
  $bg_subj_img="";		# Backgroung image for Subject
  $bg_sep="#EEEEEE";		# Color of separators
  $bg_sep_img="";		# Background image for separator lines
  $cl_text="";			# Body text color
  $cl_link="";			# Body unvisited link color
  $cl_vlink="";			# Body visited link color
  $cl_alink="";			# Body active link color
  $ap_subj_pre="";		# Subject prefix (font change, for example)
  $ap_subj_post="";		# Subject postfix (</FONT>) by default
  $format_body=1;
  $format_width=60;
  $cite_symbol=">";
  $max_entries=0;
  $adfile="";
  $acc_policy=0;
  $acc_email=0;
  $acc_image=0;
  $acc_url=0;
  $acc_passwd="userpass.dat";
  $acc_ip=0;
  $acc_ip_msgs="ipmsgs.dat";
  $acc_ip_conf="ipconf.dat";
  $acc_form_url="";
  $acc_mailer="/usr/sbin/sendmail %addr%";
  $adm_email="";
  $post_redir=0;
  $bw_file="badwords.dat";
  $antispam=1;

  # Reading configuration
  #
  &error("no_config") unless -r $cf_file;
  do $cf_file;
  &error("no_config") if $@;

  # Fixing configuration
  #
  &error("wrong_cf","No base URL (\$baseurl) defined!") if !$baseurl;
  chop($baseurl) while $baseurl =~ "/\$";
  $basedir=$config if !$basedir;
  $basedir="$homedir/$basedir" unless $basedir =~ "^/";
  $datafile="$basedir/$datafile" unless $datafile =~ "^/";
  $passwd_file="$basedir/$passwd_file" unless $passwd_file =~ "^/";
  $adfile="$basedir/$adfile" unless $adfile =~ "^/" || !$adfile;
  $messages=$mesgdir if !$messages;
  $messages="$basedir/$messages" unless $messages =~ "^/";
  mkdir($messages,0755) unless -d $messages;
  &error("wrong_cf","Bad path to messages directory ($messages)") unless -d $messages && -w _;
  $mainpage="ruboard.$ext" unless $mainpage;
  $mesgfile=$mainpage if !$mesgfile;
  $mainpage="$baseurl/$mainpage" unless $mainpage =~ "tp://";
  $mesgfile="$basedir/$mesgfile" unless $mesgfile =~ "^/";
  $cgi_url="$baseurl/$cgi_url" unless $cgi_url =~ "tp://";
  $cgi_url.="/".time;
  $admin_url="$baseurl/$admin_url" unless $admin_url =~ "tp://";
  $admin_url.="/".time;
  $faqfile="faq.$ext" unless $faqfile;
  $faqfile="$baseurl/$faqfile" unless $faqfile =~ "tp://";
  chop($cite_symbol) while $cite_symbol =~ /\s$/;
  $max_entries=scalar($max_entries);
  $acc_policy=scalar($acc_policy);
  $acc_policy=1 if $acc_policy==0 && ($acc_url==1 || $acc_image==1);
  $acc_email=scalar($acc_email);
  $acc_image=scalar($acc_image);
  $acc_url=scalar($acc_url);
  $acc_passwd="$basedir/$acc_passwd" unless $acc_passwd =~ "^/";
  $acc_ip=scalar($acc_ip);
  $acc_ip_msgs="$basedir/$acc_ip_msgs" unless $acc_ip_msgs =~ "^/";
  $acc_ip_conf="$basedir/$acc_ip_conf" unless $acc_ip_conf =~ "^/";
  $acc_form_url="$admin_url?config=$config&c=reg_form&nomenu" if $acc_form_url eq "";
  $bg_image="$baseurl/$bg_image" unless $bg_image =~ "tp://" || !$bg_image;
  $bg_image=" BACKGROUND=\"$bg_image\"" if $bg_image;
  $bg_subj_img="$baseurl/$bg_subj_img" unless $bg_subj_img =~ "tp://" || !$bg_subj_img;
  $bg_subj_img=" BACKGROUND=\"$bg_subj_img\"" if $bg_subj_img;
  $bg_sep_img="$baseurl/$bg_sep_img" unless $bg_sep_img =~ "tp://" || !$bg_sep_img;
  $bg_sep_img=" BACKGROUND=\"$bg_sep_img\"" if $bg_sep_img;
  $cl_text=" TEXT=\"$cl_text\"" if $cl_text ne "";
  $cl_link=" LINK=\"$cl_link\"" if $cl_link ne "";
  $cl_vlink=" VLINK=\"$cl_vlink\"" if $cl_vlink ne "";
  $cl_alink=" ALINK=\"$cl_alink\"" if $cl_alink ne "";
  $ap_subj_pre="<FONT COLOR=\"$ap_subj_pref\">" unless $ap_subj_pref=~/</ || $ap_subj_pref eq "";
  $ap_subj_post="</FONT>" if $ap_subj_post eq "" && $ap_subj_pre ne "";
  $format_body=scalar($format_body);
  $format_width=scalar($format_width);
  if(!$adm_email)
   { $baseurl =~ "://([-.a-zA-Z0-9]+)/";
     ($adm_email="postmaster\@$1") =~ s/\@www\./\@/;
   }
  $post_redir=scalar($post_redir);
  $bw_file="$basedir/$bw_file" unless $bw_file =~ "^/";
  $antispam=scalar($antispam);

# Languages
#
  @languages=("english","russian");
  $n=0;
  foreach(@languages)
   { if($language eq $_)
      { $n=1;
        last;
      }
   }
  if(!$n)
   { print STDERR "Unknown language `$language'. Assuming $languages[0].\n";
     $language=$languages[0];
   }

# Fields names
#@LANG@#
#
  if($language eq "russian")
   { $t_name="Имя";
     $t_passwd="Пароль";
     $t_email="E-Mail";
     $t_subject="Тема";
     $t_link_url="Ссылка (URL)";
     $t_link_text="Текст ссылки";
     $t_image="Картинка (URL)";
     $t_post="    Послать    ";
     $t_reset="    Очистить    ";
     $t_followups="Ответы";
     $t_post_followup="Послать ответ";
     $t_faq="ЧаВО";
     $t_author="Автор";
     $t_reg_note1="Доступно только";
     $t_reg_note2="зарегистрированным пользователям.";
   }
  else
   { $t_name="Name";
     $t_passwd="Password";
     $t_email="E-Mail";
     $t_subject="Subject";
     $t_link_url="Optional link URL";
     $t_link_text="Link title";
     $t_image="Optional image URL";
     $t_post="    Post Message    ";
     $t_reset="    Reset    ";
     $t_followups="Follow Ups";
     $t_post_followup="Post Followup";
     $t_faq="FAQ";
     $t_author="Author";
     $t_reg_note1="Only available for";
     $t_reg_note2="registered users";
   }
}

####################################
# Parse Form Subroutine
#
sub parse_form
{ # Get the input
  #
  if($ENV{"REQUEST_METHOD"} eq "GET")
   { $buffer=$ENV{"QUERY_STRING"};
   }
  else
   { read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
   }

  # Split the name-value pairs
  #
  @pairs = split(/&/, $buffer);
  foreach $pair (@pairs)
   { ($nm, @_) = split(/=/, $pair);
     $value=join('=',@_);

     # Un-Webify plus signs and %-encoding
     $nm =~ tr/+/ /;
     $nm =~ s/%([a-f0-9][a-f0-9])/pack("C", hex($1))/eig;
     $value =~ tr/+/ /;
     $value =~ s/%([a-f0-9][a-f0-9])/pack("C", hex($1))/eig;

     $FORM{$nm} = $value;
   }
}

###############################################################################
# Various common html tags
#
sub print_html_hr	{ print "<hr width=80%>\n"; }

###############################################################
# Converting special symbols to their HTML representations
#
sub to_html_text
{ local($_)=$_[0];
  s/&/&amp;/g;
  s/</&lt;/g;
  s/>/&gt;/g;
  $_;
}

###############################################################################
# Converting text to form string
#
sub hf
{ local($_)=&to_html_text($_[0]);
  s/\"/&quot;/g;
  $_;
}

###############################################################################
# Heading of HTML page
#
sub print_html_head
{ local($head)=$_[0];
  local($body)=$_[1];
  $body=$head if $body eq "-";
  print "Content-type: text/html\n\n" unless $printing_to_file;
  print <<EOH;
<HTML><HEAD>
<TITLE>$head</TITLE>
</HEAD>
<BODY BGCOLOR=$bg_paper$bg_image$cl_text$cl_link$cl_vlink$cl_alink>
EOH
  if($adfile)
   { if(open(AD,$adfile))
      { local($_);
        local($id)=time;
        while(<AD>)
         { s/%%ID%%/$id/;
           print;
         }
        close(AD);
      }
     else
      { print STDERR "Can't open $adfile for reading: $!\n";
      }
   }
  print <<EOH if $body;
<CENTER><FONT SIZE=+1 FACE=Verdana,Arial,Helvetica>
$body
</FONT></CENTER>
EOH
  &print_html_hr if $body;
}

###############################################################################
# Footer of HTML page
#
sub print_html_footer
{ print <<EOH unless $_[0]==1;
<HR>
<TABLE BORDER=0 CELLSPACING=0 CELLPADDING=0 WIDTH=99%><TR><TD ALIGN=RIGHT>
EOH
  print <<EOH;
<FONT SIZE=-2><I>
Served by <A HREF="http://www.amsoft.ru/ruboard/">ruboard</A> %VERSION%;
Copyright &copy; 1998 by Andrew Maltsev.
</I></FONT>
EOH
  print <<EOH unless $_[0]==1;
</TD></TR></TABLE>
</BODY>
</HTML>
EOH
}

############################
# Locking Data Number
#
sub lock_number
{ $lockname="$datafile.lock";
  $locktmp="$datafile.$$";
  open(TMP,">$locktmp") || &error;
  print TMP "$$\n";
  close(TMP);
  $to_sleep=1;
  while(!link($locktmp,$lockname))
   { open(TMP,"<$lockname");
     $pid=<TMP>;
     close(TMP);
     if(!kill 0,$pid)
      { unlink($lockname);
        last;
      }
     sleep($to_sleep++);
   }
  unlink($locktmp);
}

############################
# Unlocking Data Number
#
sub unlock_number
{ unlink("$datafile.lock");
}

###############################################################################
# Date and time in long and short formats.
#
sub calc_date
{ local($sse)=$_[0];		# Second since Epoch
  local($use_time)=$_[1];	# Time and date or only date
  local($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($sse);
  local($date,$long_date);
  $sec = "0$sec" if $sec < 10;
  $min = "0$min" if $min < 10;
  $hour = "0$hour" if $hour < 10;
  $month = ($mon + 1);
  $year += 1900;

#@LANG@#
  if($language eq "russian")		# RUSSIAN
   { @months = ("января","февраля","марта","апреля","мая","июня",
                "июля","августа","сентября","октября","ноября","декабря");
     $date = "$mday/$month/$year";
     $date = "$hour:$min:$sec $date" if $use_time;
     $long_date = "$mday $months[$mon] $year в $hour:$min:$sec";
   }
  else					# ENGLISH (default)
   { @months = ("January","February","March","April","May","June",
                "July","August","September","October","November","December");
     $date = "$month/$mday/$year";
     $date = "$hour:$min:$sec $date" if $use_time;
     $long_date = "$months[$mon] $mday, $year at $hour\:$min\:$sec";
   }

  ($date,$long_date);
}

###############################################################################
# Converting IP address to bit text (32 chars)
#
sub ip_to_bits
{ unpack("B32",pack("C4",split(/\./,$_[0])));
}

###############################################################################
# Crypting with random or specified salt
#
sub my_crypt
{ local($text)=$_[0];
  local($salt)=$_[1];
  if("$salt" eq "")
   { local($_)="./0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz";
     srand;
     $salt=substr($_,rand(64),1).substr($_,rand(64),1);
   }
  crypt($text,$salt);
}

###############################################################################
# Mailing $_[2] to $_[0] under the subject $_[1]
#
sub mailer
{ local($agent)=$acc_mailer;
  if($agent =~ /%addr%/)
   { $agent=~s/%addr%/$_[0]/g;
   }
  else
   { $agent.=" ".$_[0];
   }
  if(open(MAILER,"|$agent"))
   { print MAILER <<EOF;
From: $adm_email
To: $_[0]
Subject: $_[1]

EOF
     print MAILER $_[2];
     close(MAILER);
   }
}

###############################################################################
# Checking the text for banned words
#
sub is_banned
{ local($text)=join(" ",@_);
  return 0 unless -s $bw_file;
  if(open(F,$bw_file))
   { while(<F>)
      { chop while /[\s\n]$/;
        ($id,$when,$word)=split(/:/,$_);
        $word='\b' . $word . '\b' if $word =~ /^\w+$/;
        if($text =~ /$word/i)
         { close(F);
           return 1;
         }
      }
     close(F);
   }
  return 0;
}

###############################################################################
# Makes mailto: reference with antispam protection.
#
sub build_mailto
{ local($addr)=&to_html_text($_[0]);
  if($antispam != 1 && $antispam != 2)
   { $addr="<A HREF=\"mailto:$addr\">";
   }
  elsif($antispam == 1)
   { $addr="<A HREF=\"mailto:%20${addr}\">";
   }
  elsif($antispam == 2)
   { local($a1,$a2)=split(/\@/,$addr);
     $addr="<A HREF=\"$cgi_url?mto=$a1&a2=$a2\" ONMOUSEOVER=\"window.status='$a1'+'\@'+'$a2';return true;\">";
   }
  $addr;
}

###############################################################################
# Finish
1;
