' . 'Error ' . $errline . '

#!/usr/bin/perl
##!c:/Perl/bin/perl.exe
# lang=ja  charset=utf-8
# 
# chkmsg: 掲示板システムの安全性と安定性の確保のため、ユーザが入力したＨＴＭＬのデータの形式をチェックする。
#
# Jan. 16, 2019.
# 本ソフトウェアは、MIT license および CC0 1.0 の両方の下で配布されています。
#
# Copyright (c) 2019 New Communist Club 新共産主義クラブ
# Released under the MIT license
# https://opensource.org/licenses/mit-license.php
#
# CC0 1.0 全世界
# https://creativecommons.org/publicdomain/zero/1.0/legalcode.ja
#
#

use strict;
use warnings;
use CGI;

# global variables 
our @valid_script_tag=(
  #'<script async src="https://platform.twitter.com/widgets.js" charset="utf-8"></script>', # As is.
  '<script async src="https:\\/\\/platform\\.twitter\\.com\\/widgets\\.js" charset="utf-8"><\\/script>', # RegExp
);

our @valid_iframe_src_uri=(
  "^https:\\/\\/www\\.youtube\\.com\\/embed\\/[\\w]{11}\$" # same as "^https:\\/\\/www\\.youtube\\.com\\/embed\\/[_a-zA-Z0-9]{11}\$"
);

our %valid_single_tag_elements=(
  br=>1,
  img=>1
);

our %valid_paired_tags_elements=(
  iframe=>2,
  div=>2,
  span=>2,
  h1=>2,
  h2=>2,
  h3=>2,
  h4=>2,
  h5=>2,
  h6=>2,
  p=>2,
  pre=>2,
  blockquote=>2,
  q=>2,
  cite=>2,
  dfn=>2,
  em=>2,
  strong=>2,
  sup=>2,
  sub=>2,
  code=>2,
  kbd=>2,
  samp=>2,
  var=>2,
  abbr=>2,
  acronym=>2,
  ins=>2,
  del=>2,
  bdo=>2,
  font=>2,
  big=>2,
  small=>2,
  b=>2,
  i=>2,
  tt=>2,
  strike=>2,
  s=>2,
  u=>2,
  ul=>2,
  ol=>2,
  li=>2,
  a=>2,
);

our $true = (1==1);
our $false = ! $true;
our $cgi0=CGI->new;
# end of global variables 


# main program (sample)
#
# Usage:
#   perl chkmsg.pl 'message_file.html'
#
my $argc=@ARGV;
my $input_file;
if($argc > 0){
  $input_file = $ARGV[0];
}else{
  print "chkmsg.pl\nUsage:\n\tperl chkmsg.pl 'message_file.html'\n";
  exit;
}
open my $fh, '<', $input_file or die $!;
my $msg = do { local $/ = undef; <$fh>; };
my ($ack, $reply) = chkmsg($msg);

if($ack){
  print "$reply\n";
  print "<!-- Message Accepted -->\n";
}else{  
  print "$reply\n";
  print "<!-- Message Rejected -->\n";
}
# end of main program


# sub chkmsg
# args: string $usrmsg
# returns: (boolean $ack, string $reply)
# if $usrmsg is well-formatted HTML message, sub chkmsg returns array ($true, $reply= corrected user's HTML message).
# if $usrmsg is non-well-formatted HTML message, sub chkmsg returns array ($false, $reply = error message).
sub chkmsg {
  
  my ($usrmsg) = @_;
    
  my $usrmsg_r1=$usrmsg;

  $usrmsg_r1 =~ s/<(\s*)!(\s*)-(\s*)-/"<!--" . margin($1.$2.$3)/eg;
  $usrmsg_r1 =~ s/-(\s*)-(\s*)>/margin($1.$2) . "-->"/eg;

  my $usrmsg_r1_len=length($usrmsg_r1);

  my @cmt_lt_ary;
  my @cmt_gt_ary;
  my $p=0;
  while($p<$usrmsg_r1_len){
    $p=index $usrmsg_r1, "<!--", $p;
    if($p<0){
      last;
    }
    push @cmt_lt_ary, $p;
    $p+=4;
  }

  $p=0;
  while($p<$usrmsg_r1_len){
    $p=index $usrmsg_r1, "-->", $p;
    if($p<0){
      last;
    }
    push @cmt_gt_ary, $p+2;
    $p+=3;
  }

  my $cmt_lt_ary_sz=@cmt_lt_ary;
  my $cmt_gt_ary_sz=@cmt_gt_ary; 

  if($cmt_lt_ary_sz != $cmt_gt_ary_sz){
    return ($false, errmsg(10, __LINE__, ""));
  }

  my $num_cmt=$cmt_lt_ary_sz;

  if($num_cmt>=1){
    if($num_cmt==1){
      if($cmt_lt_ary[0]>=$cmt_gt_ary[0]){
        return ($false, errmsg(20, __LINE__, ""));
      }
    }else{
      for(my $i=0; $i<$num_cmt-1; $i++){
        if($cmt_lt_ary[$i]>=$cmt_gt_ary[$i]){
          return ($false, errmsg(30, __LINE__, ""));
        }
        if($cmt_gt_ary[$i]>=$cmt_lt_ary[$i+1]){
          return ($false, errmsg(40, __LINE__, ""));
        }
      }
      if($cmt_lt_ary[$num_cmt-1]>=$cmt_gt_ary[$num_cmt-1]){
        return ($false, errmsg(50, __LINE__, ""));
      }
    }
  }

  # comments are replaced by white spaces
  my $usrmsg_r2=$usrmsg_r1;
   
  for(my $i=0; $i<$num_cmt; $i++){
    my $n=$cmt_gt_ary[$i]-$cmt_lt_ary[$i]+1;
    substr($usrmsg_r2, $cmt_lt_ary[$i], $n, space($n));
  }

  # correct left end of the tag 
  $usrmsg_r2 =~ s/<(\s*)([a-zA-Z]+)/"<" . $2 . margin($1)/eg;
  $usrmsg_r2 =~ s/<(\s*)\/(\s*)([a-zA-Z]+)/"<\/" . $3 . margin($1 . $2)/eg;

  # correct right end of the single tag
  $usrmsg_r2 =~ s/\/(\s*)>/margin($1) . "\/>"/eg;
  # "

  # make tag start and end position array, lt_ary, gt_ary   
  my $usrmsg_r2_len=length($usrmsg_r2);
  my @lt_ary;
  my @gt_ary;

  $p=0;
  while($p<$usrmsg_r2_len){
    $p=index $usrmsg_r2, "<", $p;
    if($p<0){
      last;
    }
    push @lt_ary, $p;
    $p++;
  }

  $p=0;
  while($p<$usrmsg_r2_len){
    $p=index $usrmsg_r2, ">", $p;
    if($p<0){
      last;
    }
    push @gt_ary, $p;
    $p++;
  }

  my $lt_ary_sz=@lt_ary;
  my $gt_ary_sz=@gt_ary; 

  if($lt_ary_sz != $gt_ary_sz){
    return ($false, errmsg(60, __LINE__, ""));
  }

  my $num_tag=$lt_ary_sz;

  if($num_tag>=1){
    if($num_tag==1){
      if($lt_ary[0]>=$gt_ary[0]){
        return ($false, errmsg(70, __LINE__, ""));
      }
    }else{
      for(my $i=0; $i<$num_tag-1; $i++){
        if($lt_ary[$i]>=$gt_ary[$i]){
          return ($false, errmsg(80, __LINE__, ""));
        }
        if($gt_ary[$i]>=$lt_ary[$i+1]){
          return ($false, errmsg(90, __LINE__, ""));
        }
      }
      if($lt_ary[$num_cmt-1]>=$gt_ary[$num_cmt-1]){
        return ($false, errmsg(100, __LINE__, ""));
      }
    }
  }

  # analyze tag
  my @paired_tags_name_ary;
  my @paired_tags_type_ary;
  for(my $i=0; $i < $num_tag; $i++){
    my $tag = substr($usrmsg_r2, $lt_ary[$i],  $gt_ary[$i]-$lt_ary[$i]+1);
    if( $tag =~ /^<([a-zA-Z]+)/){
      my $tag_name = lc($1);
      my $l1=exists $valid_single_tag_elements{$tag_name};
      my $l2=exists $valid_paired_tags_elements{$tag_name};
      my $l3=$tag_name eq "script";
      
      if($l2){
        push(@paired_tags_name_ary, $tag_name);
        push(@paired_tags_type_ary, "StartTag");
      }
      
      if($l1||$l2){
        my $str = substr($tag, length($tag_name)+1);
        my ($ack, $reply)=analyze_attr_val($str, $tag_name);
        if(!$ack){
          return ($false, $reply);
        }
      }elsif($l3){
        my $str=substr($usrmsg_r2, $lt_ary[$i], $gt_ary[$i]+length("</script>")-$lt_ary[$i]+1);
#        if($str ne $valid_script_tag[0]){
#          return ($false, errmsg(120, __LINE__, $str));
#        }
        if(!chk_script_tag($str)){
          return ($false, errmsg(120, __LINE__, $str));
        }
        push(@paired_tags_name_ary, $tag_name);
        push(@paired_tags_type_ary, "StartTag");
      }else{
          return ($false, errmsg(130, __LINE__, $tag_name));
      }
    }elsif($tag =~ /^<\/([a-z]+)\s*/i){
      my $tag_name=lc($1);
      if(exists $valid_paired_tags_elements{$tag_name}){
        push(@paired_tags_name_ary, $tag_name);
        push(@paired_tags_type_ary, "EndTag");
      }elsif($tag_name eq "script"){
        push(@paired_tags_name_ary, $tag_name);
        push(@paired_tags_type_ary, "EndTag");
      }else{
          return ($false, errmsg(140, __LINE__, $tag_name));
      }
    }else{
      return ($false, errmsg(150, __LINE__, $tag)); # !StartTag && !EndTag
    }
  }

# Check Pairing and Nesting of StartTags and EndTags
  my @tag_name_stack;
  my @tag_type_stack;
  
  my $ary_sz=@paired_tags_type_ary;
  my $stack_sz;
  
  for(my $i=0; $i<$ary_sz; $i++){
    if($paired_tags_type_ary[$i] eq "StartTag"){
      push @tag_name_stack, $paired_tags_name_ary[$i];
      push @tag_type_stack, $paired_tags_type_ary[$i];
    }else{                           # $paired_tags_type_ary[$i] eq "EndTag";
      $stack_sz=@tag_type_stack;
      if($stack_sz>0){
        my $toptag_type=pop @tag_type_stack;
        my $toptag_name=pop @tag_name_stack;
        if($toptag_type ne "StartTag"){
          return ($false, errmsg(160, __LINE__, ""));
        }
        if($toptag_name ne $paired_tags_name_ary[$i]){
          return ($false, errmsg(170, __LINE__, ""));
        }
      }else{
        return ($false, errmsg(180, __LINE__, ""));
      }
    }
  }
  
  $stack_sz=@tag_type_stack;
  if($stack_sz > 0){
    return ($false, errmsg(190, __LINE__, ""));
  }
# End of Check Pairing and Nesting of StartTags and EndTags


# comment retrieve
  for(my $i=0; $i<$num_cmt; $i++){
    my $n=$cmt_gt_ary[$i]-$cmt_lt_ary[$i]+1;
    substr($usrmsg_r2, $cmt_lt_ary[$i], $n, substr($usrmsg_r1, $cmt_lt_ary[$i], $n));
  }

  my $usrmsg_r3;
  my $in_tag=$false;
#  my $usrmsg_r2_len = length($usrmsg_r2);
  my $c;

# HTML escape in Content 
  for(my $p=0; $p<$usrmsg_r2_len; $p++){
    $c=substr($usrmsg_r2, $p, 1);
    if($c eq "<"){
      $usrmsg_r3 .= "<";
      $in_tag=$true;
      next;
    }elsif($c eq ">"){
      $usrmsg_r3 .= ">";
      $in_tag=$false;
      next;
    }elsif($c eq "&"){
      if($in_tag){
        $usrmsg_r3 .= "&";
        next;
      }else{
        if(chk_char_entity_ref_num_char_ref($usrmsg_r2, $p)){
          $usrmsg_r3 .= "&";
          next;
        }else{
          $usrmsg_r3 .= $cgi0->escapeHTML("&");
          next;
        }
      }
    }else{
      if($in_tag){
        $usrmsg_r3 .= $c;
        next;
      }else{
        $usrmsg_r3 .= $cgi0->escapeHTML($c);
        next;
      }
    }
  }
  return ($true, $usrmsg_r3);
}
# end of sub chkmsg

# sub margin: replace \t -> space, \n -> space, space -> space
sub margin {
  my ($str) = @_;
  $str =~ s/\s/ /g;
  return $str;
}
# end of sub margin


# sub space: returns n spaces string
# 入力値ｎを受け取り、ｎ個の空白が連続した文字列を返す。
sub space {
  my ($n) = @_;
  my $str;
  for(my $i=0; $i<$n; $i++){
    $str .= " ";
  }
  return $str;
}
# end sub space


# sub analyze_attr_val: analyze attributes and values in a tag
# analyze_attr_val は、タグの中の属性名と値を分析するサブルーチン。
sub analyze_attr_val {
  my ($str, $tag_name) = @_;
  while(length($str)>0){
    my $attribute;
    my $value;
    my $p;
    my $l1=$false;
    my $l2=$false;
    if($str =~ /^(\s+)([a-zA-Z]+)(\s*=\s*)\"(\s*)([^<>]*)(\s*)\"/i){
      $attribute=lc($2);
      $value=$5;
      $p=length($1.$2.$3.$4.$5.$6)+2;
      $l1=$true;
    }elsif($str =~ /^(\s+)([a-zA-Z]+)(\s*=\s*)\'(\s*)([^<>]*)(\s*)\'/i){
      $attribute=lc($2);
      $value=$5;
      $p=length($1.$2.$3.$4.$5.$6)+2;
      $l2=$true;
    }else{
      ;
    }
    if( $l1 || $l2 ){
      if(substr($attribute, 0, 2) eq "on"){
        return ($false, errmsg(230,__LINE__,$str));
      }
      if($attribute eq "srcdoc"){
        return ($false, errmsg(240,__LINE__,$str));
      }
      if($tag_name eq "iframe" && $attribute eq "src"){
        if(!chk_iframe_src($value)){
        return ($false, errmsg(250,__LINE__,$str));
        }
      }
      if($attribute eq "href"){
        if($value =~ /^https?:\/\//){
          ;
        }else{
          return ($false, errmsg(260,__LINE__,$str));
        }
      }
      $str=substr($str, $p);
      next;
    }elsif($str =~ /\s*>/){
      last;
    }elsif($str =~ /\s*\/\s*>/ && exists $valid_single_tag_elements{$tag_name}){   
      last;
    }else{
      return ($false, errmsg(270,__LINE__,$str));
    }
  }
  return ($true,"");
}
# end of sub analyze_attr_val


# sub chk_script_tag: check paired script tags
sub chk_script_tag {

  my ($script_tag) = @_;
  
  my $allowd=$false;
  my $sz=@valid_script_tag;
  for(my $j=0; $j<$sz; $j++){
    if($script_tag =~ /$valid_script_tag[$j]/ ){
      $allowd=$true;
      last;
    }
  }
  return $allowd;
}
# end of sub chk_script_tag


# sub chk_iframe_src: check value of src in iframe tag 
sub chk_iframe_src {

  my ($value) = @_;
  
  my $allowd_src=$false;
  my $sz=@valid_iframe_src_uri;
  for(my $j=0; $j<$sz; $j++){
    if($value =~ /$valid_iframe_src_uri[$j]/ ){
      $allowd_src=$true;
      last;
    }
  }
  return $allowd_src;
}
# end of sub chk_iframe_src


# sub chk_char_entity_ref_num_char_ref: check if "&" refer to character entity reference or numeric character reference
sub chk_char_entity_ref_num_char_ref  {
 
  my ($msg, $p) = @_;
 
  my %character_entity_references=(
    nbsp => 0, iexcl => 0, cent => 0, pound => 0, curren => 0, 
    yen => 0, brvbar => 0, sect => 0, uml => 0, copy => 0, 
    ordf => 0, laquo => 0, not => 0, shy => 0, reg => 0, 
    macr => 0, deg => 0, plusmn => 0, sup => 0, sup => 0, 
    acute => 0, micro => 0, para => 0, middot => 0, cedil => 0, 
    sup => 0, ordm => 0, raquo => 0, frac => 0, frac => 0, 
    frac => 0, iquest => 0, Agrave => 0, Aacute => 0, Acirc => 0, 
    Atilde => 0, Auml => 0, Aring => 0, AElig => 0, Ccedil => 0, 
    Egrave => 0, Eacute => 0, Ecirc => 0, Euml => 0, Igrave => 0, 
    Iacute => 0, Icirc => 0, Iuml => 0, ETH => 0, Ntilde => 0, 
    Ograve => 0, Oacute => 0, Ocirc => 0, Otilde => 0, Ouml => 0, 
    times => 0, Oslash => 0, Ugrave => 0, Uacute => 0, Ucirc => 0, 
    Uuml => 0, Yacute => 0, THORN => 0, szlig => 0, agrave => 0, 
    aacute => 0, acirc => 0, atilde => 0, auml => 0, aring => 0, 
    aelig => 0, ccedil => 0, egrave => 0, eacute => 0, ecirc => 0, 
    euml => 0, igrave => 0, iacute => 0, icirc => 0, iuml => 0, 
    eth => 0, ntilde => 0, ograve => 0, oacute => 0, ocirc => 0, 
    otilde => 0, ouml => 0, divide => 0, oslash => 0, ugrave => 0, 
    uacute => 0, ucirc => 0, uuml => 0, yacute => 0, thorn => 0, 
    yuml => 0, fnof => 0, Alpha => 0, Beta => 0, Gamma => 0, 
    Delta => 0, Epsilon => 0, Zeta => 0, Eta => 0, Theta => 0, 
    Iota => 0, Kappa => 0, Lambda => 0, Mu => 0, Nu => 0, 
    Xi => 0, Omicron => 0, Pi => 0, Rho => 0, Sigma => 0, 
    Tau => 0, Upsilon => 0, Phi => 0, Chi => 0, Psi => 0, 
    Omega => 0, alpha => 0, beta => 0, gamma => 0, delta => 0, 
    epsilon => 0, zeta => 0, eta => 0, theta => 0, iota => 0, 
    kappa => 0, lambda => 0, mu => 0, nu => 0, xi => 0, 
    omicron => 0, pi => 0, rho => 0, sigmaf => 0, sigma => 0, 
    tau => 0, upsilon => 0, phi => 0, chi => 0, psi => 0, 
    omega => 0, thetasym => 0, upsih => 0, piv => 0, bull => 0, 
    hellip => 0, prime => 0, Prime => 0, oline => 0, frasl => 0, 
    weierp => 0, image => 0, real => 0, trade => 0, alefsym => 0, 
    larr => 0, uarr => 0, rarr => 0, darr => 0, harr => 0, 
    crarr => 0, lArr => 0, uArr => 0, rArr => 0, dArr => 0, 
    hArr => 0, forall => 0, part => 0, exist => 0, empty => 0, 
    nabla => 0, isin => 0, notin => 0, ni => 0, prod => 0, 
    sum => 0, minus => 0, lowast => 0, radic => 0, prop => 0, 
    infin => 0, ang => 0, and => 0, or => 0, cap => 0, 
    cup => 0, int => 0, there => 0, sim => 0, cong => 0, 
    asymp => 0, ne => 0, equiv => 0, le => 0, ge => 0, 
    sub => 0, sup => 0, nsub => 0, sube => 0, supe => 0, 
    oplus => 0, otimes => 0, perp => 0, sdot => 0, lceil => 0, 
    rceil => 0, lfloor => 0, rfloor => 0, lang => 0, rang => 0, 
    loz => 0, spades => 0, clubs => 0, hearts => 0, diams => 0, 
    quot => 0, amp => 0, lt => 0, gt => 0, OElig => 0, 
    oelig => 0, Scaron => 0, scaron => 0, Yuml => 0, circ => 0, 
    tilde => 0, ensp => 0, emsp => 0, thinsp => 0, zwnj => 0, 
    zwj => 0, lrm => 0, rlm => 0, ndash => 0, mdash => 0, 
    lsquo => 0, rsquo => 0, sbquo => 0, ldquo => 0, rdquo => 0, 
    bdquo => 0, dagger => 0, Dagger => 0, permil => 0, lsaquo => 0, 
    rsaquo => 0, euro => 0
  );
  my $str=substr($msg, $p+1, 9);
  if ($str eq ""){
    return $false;
  }else{
    my $q=index($str, ";");
    if($q >=0){
      my $str1=substr($str, 0, $q);
      if(exists $character_entity_references{$str1}){ # character entity reference
        return $true;
      }elsif($str1 =~ /^#[0-9]+$/){  # decimal numeric character reference
        return $true;
      }elsif($str1 =~ /^#x[0-9a-f]+$/i){ # hexadecimal numeric character reference
        return $true;
      }else{
        return $false;
      }
    }else{
      return $false;
    }
  }
}
# end of sub chk_char_entity_ref_num_char_ref


# sub errmsg: make error message in HTML
sub errmsg {
  my ($errnum, $errline, $wrong_code) = @_;

  my %description = (
    10=>'コメントの開始記号 <!-- と終了記号 --> の個数が一致しません。',
    20=>'コメントの開始記号 <!-- と終了記号 --> の並び順が間違っています。',
    30=>'コメントの開始記号 <!-- と終了記号 --> の並び順が間違っています。',
    40=>'コメントの開始記号 <!-- と終了記号 --> の並び順が間違っています。',
    50=>'コメントの開始記号 <!-- と終了記号 --> の並び順が間違っています。',
    60=>'タグの左端の記号 < と、タグの右端の記号 > の個数が一致しません。',
    70=>'タグの左端の記号 < と、タグの右端の記号 > の並び順が間違っています。',
    80=>'タグの左端の記号 < と、タグの右端の記号 > の並び順が間違っています。',
    90=>'タグの左端の記号 < と、タグの右端の記号 > の並び順が間違っています。',
    100=>'タグの左端の記号 < と、タグの右端の記号 > の並び順が間違っています。',
    110=>'タグの左端の記号 < と、タグの右端の記号 > の並び順が間違っています。',
    120=>'script タグの記述に誤りがあります。セキュリティ上の理由により、script タグで記述できる内容は限定されています。Twitter を引用する場合には、<script async src="https://platform.twitter.com/widgets.js" charset="utf-8"></script> と、空白部分を含めて一字一句間違えずに入力してください。',
    130=>'開始タグで、利用できないタグ名が使われています。セキュリティ上の理由により、掲示板への書き込みで利用できるＨＴＭＬのタグ名（要素名）は限定されています。',
    140=>'終了タグで、利用できないタグ名が使われています。セキュリティ上の理由により、掲示板への書き込みで利用できるＨＴＭＬのタグ名（要素名）は限定されています。',
    150=>'タグの記述に誤りがあります。開始タグと終了タグの、どちらとも認識できませんでした。',
    160=>'開始タグと終了タグの並び順が間違っています。終了タグの直前のタグは、同じタグ名の開始タグでなければなりません。',
    170=>'終了タグの直前のタグが、同じタグ名の開始タグになっていません。異なるタグ名の要素間は互いに「入れ子」の関係になっていなければなりません。',
    180=>'入力したＨＴＭＬデータ中の開始タグと終了タグの個数が違っています。開始タグと終了タグの個数は同じでなければなりません。',
    190=>'入力したＨＴＭＬデータ中の開始タグと終了タグの個数が違っています。開始タグと終了タグの個数は同じでなければなりません。',
    230=>'セキュリティ上の理由により、onload　onclick　onerror　のような　on で始まる属性名を使って、イベント発生時の動作を定義することはできません。',
    240=>'セキュリティ上の理由により、属性名 srcdoc を使って、iframe タグを記述することはできません。',
    250=>'iframe タグで、利用できない URI が src で指定されています。セキュリティ上の理由により、iframe タグで属性名 src によって指定できる URI は限定されています。',
    260=>'セキュリティ上の理由により、a タグで、属性名 href を使って指定できる値は、http:// または https:// で始まる URI に限定されています。',
    270=>'タグの記述が間違っています。属性名と値を正しく読み込めません。',
  );

  my $header='<!DOCTYPE html><html><head><title>HTML Message Input Error</title><meta http-equiv="content-type" content="text/html; charset=utf-8"></head><body>';
  my $error_title='<h1>' . 'Error ' . $errline . '</h1>';
  $wrong_code='<pre><strong><font color="red">' . $cgi0->escapeHTML($wrong_code) . '</font></strong></pre>';
  my $error_description=$cgi0->escapeHTML($description{$errnum});
  $error_description='<p>' . $error_description . '</p>';
  my $footer='</body></html>';

  my $error_message = $header . $error_title . $wrong_code . $error_description . $footer;
  
  return $error_message;
}
# end of sub errmsg