#!/usr/bin/perl #################################################################### # Script: | FAQ Manager # # Version: | 1.0 # # By: | Jason Berry (i2 Services, Inc. / CGI World) # # Contact: | jason@cgi-world.com # # WWWeb: | http://www.cgi-world.com # # Copyright: | 1996-2000 CGI World / I2 Services, Inc. # # Released: | December 1st, 1999 # # | # #################################################################### # By using this software, you have agreed to the license # # agreement packaged with this program. # # # # Do Not Edit Below This Line - Violation of Product License # # Agreement. # #################################################################### $SIG{__DIE__} = $SIG{__WARN__} = \&HTML_Error; # show error msg on die/warn if ($0=~m#^(.*)\\#){ $base_dir = "$1"; } elsif ($0=~m#^(.*)/# ){ $base_dir = "$1"; } else {`pwd` =~ /(.*)/; $base_dir = "$1"; } $cgiurl = $ENV{'SCRIPT_NAME'}; $|++; # Files & Dirs Used: #################################################################### $data_dir = "$base_dir/faq_manager"; $template_dir = "$data_dir/templates"; $mailfile_dir = "$data_dir/mail_files"; $group_dbase = "$data_dir/faq_groups.dat"; $config_dbase = "$data_dir/faq_config.dat"; $newquestion_dbase = "$data_dir/new_questions.dat"; $filelock = "$data_dir/filelock"; # Display Images: #################################################################### if($ENV{'QUERY_STRING'} =~ /gif$|jpg$/i) { &Display_Image; } ### Database fields @gfields = qw(num sort_num group description template output_type); @ffields = qw(num sort_num question answer updated); @config_fields = qw(num admin_password faq_directory faq_url index_file index_template file_extension mailprog admin_email use_mailprog interact_url blat_smtp_server blat_port admin_cgi_url); @ifields = qw(num new_question full_name email); &DB_Load($config_dbase,$filelock,\@config_fields,1); if(!$admin_password) { $config_startup = 1 }; %in = &ReadForm; %cookies = &ReadCookie; if($config_startup) { print "Content-Type: text/html\n\n"; &Config_Edit; exit; } if($login_password) { $login_password = crypt($login_password,FM) }; if($login_password && $login_password eq "$admin_password") { &SetCookie("cookie_password","$admin_password"); } elsif(!$cookie_password && $admin_password && !$save_config || $cookie_password ne "$admin_password" && !$save_config) { print "Content-Type: text/html\n\n"; &admin_login; exit; } if($save_config) { &SetCookie("cookie_password","$admin_password") }; print "Content-Type: text/html\n\n"; if($publish) { &Publish }; if($edit_config && !$view_main) { &Config_Edit }; if($view_templates && !$view_main) { &Template_Manager }; if($modify && !$view_main) { &modify }; if($new_questions && !$view_main) { &new_questions }; if($add && !$view_main) { &add }; if($edit && !$view_main) { &edit }; if($delete && !$view_main) { &delete }; #################################################### # FAQ Manager v1.0 (Main Menu): if(!$ENV{'QUERY_STRING'}) { $secs = time - $^T; if($faq_url) { $faq_dir_url .= "View Your FAQ Area |" }; if($interact_url) { $faq_dir_url .= " Interaction Script" }; open(NEWQS,"<$newquestion_dbase"); @new_qs = ; close(NEWQS); $new_count = @new_qs; if(@new_qs) { $new_questions = "SUBMISSIONS ( $new_count )" }; # Add New Group: ################################################# if($action eq "add_group" && $output_type && $group && $template) { &DB_Add($group_dbase, $filelock, \@gfields); } # Delete Group: ################################################# if($action eq "delete_group" && $num && !$back) { &DB_Del($group_dbase, $filelock, $num); unlink("$data_dir/$num.dat"); } # Update Group: ################################################# if($action eq "edit_group" && $num && !$back) { &DB_Save($group_dbase, $filelock, \@gfields, $num); } ################################################# # Output Group List: &Template("$data_dir/_groups_list.html"); ###### $sortcode = sub { $a_name = &DB_Field("sort_num",\@gfields,$a); $b_name = &DB_Field("sort_num",\@gfields,$b); $b_name <=> $a_name; }; ###### $rowcode = sub { open(QFILE,"<$data_dir/$num.dat"); @qfilecount = ; close(QFILE); $qcount = @qfilecount; $list_groups .= &Cell("groups"); }; &DB_List($group_dbase,$filelock,\@gfields,$rowcode,$sortcode); print &Template("$data_dir/_groups_list.html"); } #################################################### # FAQ Generator (Modify Group Questions) sub modify { $question_file = "$data_dir/$modify.dat"; # Delete Group: ################################################# if($action eq "delete_faq" && $num && !$back) { &DB_Del($question_file, $filelock, $num); } # Add New FAQ Question: ################################################# if($action eq "add_faq" && $question && $answer && !$back) { if($preview) { $preview_answer = "$answer"; $preview_answer =~ s/\n/
/g; $answer = &DB_Encode("$answer"); $answer =~ s/"/"/g; &Template("$data_dir/_faq_preview.html"); print &Template("$data_dir/_faq_preview.html"); exit; } if($previewed) { $answer = &DB_Decode("$answer") }; &DB_Add($question_file, $filelock, \@ffields); } # Update FAQ Question: ################################################# if($action eq "edit_faq" && $question && $answer && !$back) { if($move_to) { &DB_Del($question_file, $filelock, $num); $add_to = "$data_dir/$move_to.dat"; &DB_Add($add_to, $filelock, \@ffields); } if(!$move_to) { &DB_Save($question_file, $filelock, \@ffields, $num); } } #################################################### # FAQ Generator (Delete FAQ) if($ENV{'QUERY_STRING'} && $modify && $delete) { $faq_file = "$data_dir/$modify.dat"; &Template("$data_dir/_faq_delete.html"); &DB_Load($faq_file, $filelock, \@ffields, $delete); $answer =~ s/\n/
/g; print &Template("$data_dir/_faq_delete.html"); exit; } ################################################# # Add New Question: if($modify && $add && !$add_question) { &Template("$data_dir/_faq_add.html"); @num_fields = ("num","sort_num"); $addcode = sub { if($sort_num > $sortnum) { $sortnum = $sort_num }; }; &DB_List($question_file,$filelock,\@num_fields,$addcode); $sortnum++; &DB_Load($group_dbase, $filelock, \@gfields, $modify); ($sec,$min,$hour,$day,$month,$year) = localtime(time); $year += 1900; &convert_month; if(!$updated) { $updated = "$month $day, $year" }; if($answer) { $answer = &DB_Decode("$answer") }; print &Template("$data_dir/_faq_add.html"); exit; } ################################################# # Modify Question: if($modify && $edit) { &Template("$data_dir/_faq_edit.html"); open(GROUPS,"<$group_dbase"); @groups = ; close(GROUPS); foreach$lgroup(@groups) { ($g_num,$gsort,$group_name) = split(/\|/,$lgroup); $group_list .= &Cell("print_groups"); } &DB_Load($group_dbase, $filelock, \@gfields, $modify); &DB_Load($question_file, $filelock, \@ffields, $edit); ($sec,$min,$hour,$day,$month,$year) = localtime(time); $year += 1900; &convert_month; $updated = "$month $day, $year"; $question =~ s/"/"/g; print &Template("$data_dir/_faq_edit.html"); } # List FAQ Group Questions : ################################################# else { &Template("$data_dir/_faq_list.html"); ###### $sortcode = sub { $a_name = &DB_Field("sort_num",\@gfields,$a); $b_name = &DB_Field("sort_num",\@gfields,$b); $b_name <=> $a_name; }; ###### &DB_Load($group_dbase, $filelock, \@gfields, $modify); $rowcode = sub { $list_questions .= &Cell("questions"); }; &DB_List($question_file,$filelock,\@ffields,$rowcode,$sortcode); print &Template("$data_dir/_faq_list.html"); } exit; } #################################################### # Add: sub add { #################################################### # FAQ Generator (Add New Group) if($ENV{'QUERY_STRING'} && $add) { &Template("$data_dir/_groups_add.html"); open(GROUPS,"<$group_dbase"); @records = ; close(GROUPS); $sortnum = 0; $rowcode = sub { if($sort_num > $sortnum) { $sortnum = $sort_num }; }; &DB_List($group_dbase,$filelock,\@gfields,$rowcode); $sortnum++; opendir(TEMPDIR,"$template_dir"); @templates = readdir(TEMPDIR); closedir(TEMPDIR); foreach$template_file(@templates) { if($template_file =~ /^_/) { $template_selection .= &Cell("template_dropdown"); } } print &Template("$data_dir/_groups_add.html"); } } #################################################### # Edit: sub edit { #################################################### # FAQ Generator (Edit Group) if($ENV{'QUERY_STRING'} && $edit) { &Template("$data_dir/_groups_edit.html"); &DB_Load($group_dbase, $filelock, \@gfields, $edit); opendir(TEMPLATES,"$template_dir"); @templates = readdir(TEMPLATES); closedir(TEMPLATES); foreach$template_file(sort @templates) { if($template_file =~ /^_/) { $loaded_template = "\"$template_file\""; if($loaded_template eq "\"$template\"") { $loaded_template = "$loaded_template selected"; } $template_files .= &Cell("list_templates"); } } print &Template("$data_dir/_groups_edit.html"); } exit; } #################################################### # Delete sub delete { #################################################### # FAQ Generator (Delete Group) if($ENV{'QUERY_STRING'} && $delete && !$modify) { &Template("$data_dir/_groups_delete.html"); &DB_Load($group_dbase, $filelock, \@gfields, $delete); print &Template("$data_dir/_groups_delete.html"); } exit; } # Config Files: #################################################### sub Config_Edit { if($save_config) { if($file_extension !~ /^\./) { $file_extension = ".$file_extension" }; if($file_extension =~ /^\.$/) { $file_extension = ".html" }; if($admin_password && $admin_password !~ /^FM/) { $admin_password = crypt($admin_password,FM) }; if($faq_directory =~ /\/$|\\$/) { chop($faq_directory) }; &DB_Save($config_dbase, $filelock,\@config_fields,1); } &Template("$data_dir/_config.html"); undef($use_mailprog_sendmail_checked); undef($use_mailprog_blatmail_checked); &DB_Load($config_dbase,$filelock,\@config_fields,1); opendir(TEMPLATES,"$template_dir"); @templates = readdir(TEMPLATES); closedir(TEMPLATES); foreach$template_file(sort @templates) { if($template_file =~ /^_/) { $loaded_template = "\"$template_file\""; if($loaded_template eq "\"$index_template\"") { $loaded_template = "$loaded_template selected"; } $template_files .= &Cell("list_templates"); } } print &Template("$data_dir/_config.html"); exit; } # Admin Login: #################################################### sub Publish { $pages = 1; opendir(FAQDIR,"$faq_directory"); @fd_files = readdir(FAQDIR); close(FAQDIR); foreach$fd_file(@fd_files) { if($fd_file =~ /$file_extension|.html|.shtml|.htm/i) { unlink("$faq_directory/$fd_file"); } } &DB_Load($config_dbase,$filelock,\@config_fields, 1); $files_created .= "
  • Page $pages. FAQ Index
    \n"; &Template("$template_dir/$index_template"); &Template("$template_dir/_publish_faq.html"); ###### $sortcode = sub { $a_name = &DB_Field("sort_num",\@gfields,$a); $b_name = &DB_Field("sort_num",\@gfields,$b); $b_name <=> $a_name; }; ###### $faqlist_code = sub { $pages++; $file_num = "$num"; &get_qcount; $index_listing .= &Cell("faq_groups"); &create_faq; }; &DB_List($group_dbase,$filelock,\@gfields,$faqlist_code,$sortcode); sub get_qcount { undef($q_count); open(QFILE,"<$data_dir/$file_num.dat"); @qcount = ; close(QFILE); $q_count = @qcount; } open(INDEX,">$faq_directory/$index_file"); print INDEX &Template("$template_dir/$index_template"); close(INDEX); } #################################################### # Create FAQ Group Pages: sub create_faq { undef($faq_answers); undef($faq_questions); $question_file = "$data_dir/$num.dat"; $fcount = 0; $files_created .= "
  • Page $pages. FAQ Index: $group
    \n"; &Template("$template_dir/$template"); ###### $sortcode = sub { $a_name = &DB_Field("sort_num",\@gfields,$a); $b_name = &DB_Field("sort_num",\@gfields,$b); $b_name <=> $a_name; }; ###### $list_qa = sub { $answer =~ s/\n/
    /g; $fcount++; if($output_type eq "single") { $qurl = "#$num" } else { $pages++; $qurl = "$file_num.$num$file_extension" }; $faq_questions .= &Cell("list_questions"); $faq_answers .= &Cell("list_answers"); &create_single; }; &DB_List($question_file,$filelock,\@ffields,$list_qa,$sortcode); if($output_type eq "multiple") { undef($faq_answers) }; $page_title = "$group"; open(FAQ,">$faq_directory/$file_num$file_extension"); print FAQ &Template("$template_dir/$template"); close(FAQ); } # Create Single FAQ Pages: #################################################### sub create_single { if($output_type eq "multiple") { &Template("$template_dir/$template"); $faq_answers = &Cell("list_answers"); &DB_Load($question_file,$filelock,\@ffields, $num); $store_questions = "$faq_questions"; undef($faq_questions); $page_title = "$question"; open(SINGLEFAQ,">$faq_directory/$file_num.$num$file_extension"); print SINGLEFAQ &Template("$template_dir/$template"); close(SINGLEFAQ); $faq_questions = "$store_questions"; $files_created .= "
  • Page $pages. FAQ Index: $group: $question
    \n"; } } # Submitted Questions: #################################################### sub new_questions { # Add Submitted Question: ################################################# if($action eq "add_question" && $question && $answer && $send_to) { $sortnum = 0; $question1 = "$question"; $answer1 = "$answer"; $question_file = "$data_dir/$send_to.dat"; $rowcode = sub { if($sort_num > $sortnum) { $sortnum = $sort_num }; }; &DB_List($question_file,$filelock,\@ffields,$rowcode); $sortnum++; $sort_num = $sortnum; $question = "$question1"; $answer = "$answer1"; &DB_Add($question_file, $filelock, \@ffields); &DB_Load($newquestion_dbase,$filelock,\@ifields, $qid); &DB_Del($newquestion_dbase, $filelock, $qid); $answer = &DB_Decode("$answer"); $question = &DB_Decode("$question"); undef($qid); # Send out mail (Using Sendmail) ################################ if($use_mailprog eq "sendmail" && $admin_email && $mailprog && $mail_user) { open(MAIL,"|$mailprog -t"); print MAIL "To: $email\n"; print MAIL "From: $admin_email \n"; print MAIL "Subject: Answer to your Submitted Question...\n"; print MAIL "X-Courtesy-Of: FAQ Manager by I2 Services, Inc.\n\n"; &Template("$mailfile_dir/_answered_question.txt"); print MAIL &Template("$mailfile_dir/_answered_question.txt"); close(MAIL); } # Send Out Mail (Using Blat Mail) ################################# elsif($use_mailprog eq "blatmail" && $admin_email && $mail_user) { $tempfile = "$data_dir/tempemail.txt"; &FileLock("$filelock"); open(MAIL,">$tempfile") || die("Cannot open $tempfile -- Check Directory Permissions : $!"); #Date $date = localtime(time); $subject = "Answer to your Subitted Question..."; print MAIL "-" x 75 . "\n\n"; &Template("$mailfile_dir/_answered_question.txt"); print MAIL &Template("$mailfile_dir/_answered_question.txt"); close(MAIL); $blatcmd = qq($base_dir/blat.exe $tempfile -t "$email" -f "$admin_email" -s "$subject" -server $blat_smtp_server -port $blat_port -noh2 -q); system("$blatcmd"); unlink($tempfile); &FileUnlock("$filelock") } } # Delete New Question: ################################################# if($new_questions eq "delete" && $qid) { &DB_Del($newquestion_dbase, $filelock, $qid); } ################################################# # Add Question HTML: if($new_questions eq "edit" && $qid) { &Template("$data_dir/_new_question_answer.html"); &DB_Load($newquestion_dbase,$filelock,\@ifields, $qid); $input_question = "$new_question"; if($email) { $full_name = "$full_name" }; $input_question =~ s/\n/
    /g; ($sec,$min,$hour,$day,$month,$year) = localtime(time); $year += 1900; &convert_month; $updated = "$month $day, $year"; open(GROUPS,"<$group_dbase"); @groups = ; close(GROUPS); foreach$lgroup(@groups) { ($g_num,$gsort,$group_name) = split(/\|/,$lgroup); $group_list .= &Cell("print_groups"); } if($email) { $email_option = &Cell("email_html") }; print &Template("$data_dir/_new_question_answer.html"); exit; } ################################################# # View New Questions: else { &Template("$data_dir/_view_new_questions.html"); $newq = sub { $new_question =~ s/\n/
    /g; $list_new_questions .= &Cell("nquestions"); }; &DB_List($newquestion_dbase,$filelock,\@ifields,$newq); print &Template("$data_dir/_view_new_questions.html"); exit; } } # Admin Login: #################################################### sub admin_login { &Template("$data_dir/_admin_login.html"); &DB_Load($config_dbase,$filelock,\@config_fields, 1); if($login_password) { $login_error = "Invalid Admin Password..." }; if($ENV{'QUERY_STRING'}) { $qstring = "$ENV{'QUERY_STRING'}"; @qsvalues = split(/&/,$qstring); foreach$qpair(@qsvalues) { ($qsname,$qsvalue) = split(/=/,$qpair); $hidden_commands .= &Cell("qstring_commands"); } } print &Template("$data_dir/_admin_login.html"); } # FAQ Manager: Template Manager: #################################################### sub Template_Manager { # Save Template ################################################# if($save_template) { $template =~ s/\n//gi; if($file_name !~ /^_/) { $file_name = "_$file_name" }; &FileLock("$filelock"); open(PTEMPLATE,">$template_dir/$file_name"); print PTEMPLATE "$template"; close(PTEMPLATE); &FileUnlock("$filelock"); } # Delete Template ################################################# if($delete_template && !$back) { unlink("$template_dir/$delete_template"); } # Delete Template Confirm ################################################# if($delete_template_confirm && $load_template ne "new") { &Template("$data_dir/_template_delete.html"); print &Template("$data_dir/_template_delete.html"); exit; } # Output Template ################################################# &Template("$data_dir/_edit_templates.html"); opendir(TEMPLATES,"$template_dir"); @templates = readdir(TEMPLATES); closedir(TEMPLATES); foreach$template(sort @templates) { if($template =~ /^_/) { $loaded_template = "\"$template\""; if($loaded_template eq "\"$load_template\"") { $loaded_template = "$loaded_template selected"; } $template_files .= &Cell("list_templates"); } } if($load_template) { $template_msg = "When variables are used (\$xxxx) in the window below, make sure the variable starts & ends with a dollar sign. \$xxx\$"; if($load_template eq "new") { $load_template = "_"; } else { open(LTEMPLATE,"<$template_dir/$load_template"); @template = ; close(LTEMPLATE); $template_contents = join('',@template); $template_contents =~ s/<\/textarea>/<\/textarea>/gi; } $textarea_box = &Cell("html_template"); } print &Template("$data_dir/_edit_templates.html"); exit; } # HTML_Error : Display an HTML Error Message & Exit: #################################################### sub HTML_Error { print "Content-type: text/html\n\n"; &DB_Unlock($filelock); # File Unlock print "@_"; exit; } # Display Images: #################################################### sub Display_Image { my($image) = $ENV{'QUERY_STRING'}; # Image name/path $image =~ s/[^A-Za-z0-9\.\/\\_-]//gs; # Remove bad chars $image =~ s/\.\.//gs; # Remove parent dir references open(FILE,"<$data_dir/images/$image") || die("Display_Image : Can't read image $data_dir/images/ : $!\n"); binmode(FILE); binmode(STDOUT); print "Content-type: image/gif\n\n"; print ; close(FILE); exit; } # Convert Month: #################################################### sub convert_month { if($month eq "0") { $month = "January" }; if($month eq "1") { $month = "February" }; if($month eq "2") { $month = "March" }; if($month eq "3") { $month = "April" }; if($month eq "4") { $month = "May" }; if($month eq "5") { $month = "June" }; if($month eq "6") { $month = "July" }; if($month eq "7") { $month = "August" }; if($month eq "8") { $month = "September" }; if($month eq "9") { $month = "October" }; if($month eq "10") { $month = "November" }; if($month eq "11") { $month = "December" }; } # Parse Form: #################################################### sub ReadForm { my($max) = $_[1]; # Max Input Size my($name,$value,$pair,@pairs,$buffer,%hash); # localize variables # Check input size if max input size is defined if ($max && ($ENV{'CONTENT_LENGTH'}||length $ENV{'QUERY_STRING'}) > $max) { die("ReadForm : Input exceeds max input limit of $max bytes\n"); } # Read GET or POST form into $buffer if ($ENV{'REQUEST_METHOD'} eq 'POST') { read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'}); } elsif ($ENV{'REQUEST_METHOD'} eq 'GET') { $buffer = $ENV{'QUERY_STRING'}; } @pairs = split(/&/, $buffer); # Split into name/value pairs foreach $pair (@pairs) { # foreach pair ($name, $value) = split(/=/, $pair); # split into $name and $value $value =~ tr/+/ /; # replace "+" with " " $value =~ s/%([A-F0-9]{2})/pack("C", hex($1))/egi; # replace %hex with char # $hash{$name} = $value; # Sort FAQ Groups: ################################################## if($name =~ /^sortrecord/) { ($bogus,$nrecord) = split(/_/,$name); &DB_Load($group_dbase, $filelock, \@gfields, $nrecord); $sort_num = "$value"; &DB_Save($group_dbase, $filelock, \@gfields, $nrecord); } # Sort FAQ Quesions: ################################################## if($name =~ /^sortquestion/) { ($bogus,$nrecord,$question_file) = split(/_/,$name); $qfile = "$data_dir/$question_file.dat"; &DB_Load($qfile, $filelock, \@ffields, $nrecord); $sort_num = "$value"; &DB_Save($qfile, $filelock, \@ffields, $nrecord); } if($name =~ /\.y$/ || /\.x$/) { $name =~ s/.x//gi; $name =~ s/.y//gi; } $$name = "$value"; } return %hash; } # ------------------------------------------------------------------------ # Template : Open a template file, translate variables and return contents # # usage : print &Template("$cgidir/filename.html",'html'); # ------------------------------------------------------------------------ sub Template { local(*FILE); my($hash) = $_[1]; if (!$_[0]) { return "
    \nTemplate : No file was specified
    \n"; } elsif (!-e "$_[0]") { return "
    \nTemplate : File '$_[0]' does not exist
    \n"; } else { open(FILE, "<$_[0]") || return "
    \nTemplate : Could open $_[0]
    \n"; while () { $FILE .= $_; } close(FILE); for ($FILE) { s//\1/gi; # show hidden inserts s/(?:\r\n|\n)?(.*?)/ $CELL{$1}=$2;''/ges; # read/remove template cells if ($hash) { s/\$(\w+)\$/$hash->$1/g; } # translate $scalars$ else { s/\$(\w+)\$/${$1}/g; } } } return $FILE; } # ------------------------------------------------------------------------ # Cell : Return a template cell with translated variables. # Note: Before you can read a cell you need to load the template. # # usage : print &Cell("cellname"); # ------------------------------------------------------------------------ sub Cell { my($CELL); my($hash) = $_[1]; for (0..$#_) { if ($_[$_]) { $CELL .= $CELL{$_[$_]}; }} if (!$_[0]) { return "
    \nCell : No cell was specified
    \n"; } elsif (!$CELL) { return "
    \nCell : Cell '$_[0]' is not defined
    \n"; } else { if ($hash) { $CELL =~ s/\$(\w+)\$/$hash->{$1}/g; } # translate $scalars$ else { $CELL =~ s/\$(\w+)\$/${$1}/g; } } # translate $scalars$ return $CELL; } # ---------------------------------------------------------------------------- # FileLock : File locking/unlocking Perl routines. # # Usage : &FileLock("$lockdir"); # : &FileUnlock("$lockdir"); # ---------------------------------------------------------------------------- sub FileLock { my($i); # sleep counter while (!mkdir($_[0],0777)) { # if there already is a lock sleep 1; # sleep for 1 sec and try again if (++$i>60) { die("File_Lock : Can't create filelock : $!\n"); } } } sub FileUnlock { rmdir($_[0]); # remove file lock dir } # ---------------------------------------------------------------------------- # MIME64 : MIME64 encoding/decoding Perl routines. MIME64 is a common base64 # encoding scheme documented in RFC1341, section 5.2. # # Usage : $mime64_text = &MIME64_Encode("$plaintext"); # : $plaintext = &MIME64_Decode("$mime64_text"); # ---------------------------------------------------------------------------- sub MIME64_Encode { my($in) = $_[0]; # text to encode my(@b64) = ((A..Z,a..z,0..9),'+','/'); # Base 64 char set to use my($out) = unpack("B*",$in); # Convert to binary $out=~ s/(\d{6}|\d+$)/$b64[ord(pack"B*","00$1")]/ge; # convert 3 bytes to 4 while (length($out)%4) { $out .= "="; } # Pad string with '=' return $out; # Return encoded text } sub MIME64_Decode { my($in) = $_[0]; # encoded text to decode my(%b64); # Base 64 char set hash my($out); # decoded text variable for((A..Z,a..z,0..9),'+','/'){ $b64{$_} = $i++ } # Base 64 char set to use $in = $_[0] || return "MIME64 : Nothing to decode"; # Get input or return $in =~ s/[^A-Za-z0-9+\/]//g; # Remove invalid chars $in =~ s/[A-Za-z0-9+\/]/unpack"B*",chr($b64{$&})/ge; # b64 offset val -> bin $in =~ s/\d\d(\d{6})/$1/g; # Convert 8 bits to 6 $in =~ s/\d{8}/$out.=pack("B*",$&)/ge; # Convert bin to text return $out; # Return decoded text } # ---------------------------------------------------------------------------- # URL : URL encoding/decoding Perl routines. URL encoding is an common # encoding scheme where non A-Za-z0-9+*.@_- characters are replaced # with a character triplet of "%" followed by the two hex digits. # # Usage : $URL_encoded = &URL_Encode("$plaintext"); # : $plaintext = &URL_Decode("$URL_encoded"); # ---------------------------------------------------------------------------- sub URL_Encode { my($text) = $_[0]; # text to URL encode $text =~ tr/ /+/; # replace " " with "+" $text =~ s/[^A-Za-z0-9\+\*\.\@\_\-]/ # replace odd chars uc sprintf("%%%02x",ord($&))/egx; # with %hex value return $text; # return URL encoded text } sub URL_Decode { my($text) = $_[0]; # URL encoded text to decode $text =~ tr/+/ /; # replace "+" with " " $text =~ s/%([A-F0-9]{2})/pack("C", hex($1))/egi; # replace %hex with chars return $text; # return decoded plain text } # ---------------------------------------------------------------------------- # Cookie : Perl routines for setting/reading browser cookies. # : Cookies have a max size of 4k and each host can send up to 20. # # Usage : &SetCookie("name","value"); # : %cookie = &ReadCookie; # ---------------------------------------------------------------------------- sub SetCookie { my($cookie_info); my($name,$value,$exp,$path,$domain,$secure) = @_; # $name - cookie name (ie: username) # $value - cookie value (ie: "joe user") # $exp - exp date, cookie will be deleted at this date. Format: Wdy, DD-Mon-YYYY HH:MM:SS GMT # $path - Cookie is sent only when this path is accessed (ie: /); # $domain - Cookie is sent only when this domain is accessed (ie: .edis.org) # $secure - Cookie is sent only with secure https connection unless (defined $name) { die("SetCookie : Cookie name must be specified\n"); } if ($exp && $exp !~ /^[A-Z]{3}, \d\d-[A-Z]{3}-\d{4} \d\d:\d\d:\d\d GMT$/i) { die("SetCookie : Exp Dat format isn't: Wdy, DD-Mon-YYYY HH:MM:SS GMT\n"); } if ($name) { $name = &URL_Encode($name); } if ($value) { $value = &URL_Encode($value); } if ($exp) { $cookie_info .= "expires=$exp; "; } if ($path) { $cookie_info .= "path=$path; "; } if ($domain) { $cookie_info .= "domain=$domain; "; } if ($secure) { $cookie_info .= "secure; "; } print "Set-Cookie: $name=$value; $cookie_info\n"; } sub ReadCookie { my($cookie,$name,$value,%jar); foreach $cookie (split(/; /,$ENV{'HTTP_COOKIE'})) { # for each cookie sent ($name,$value) = split(/=/,$cookie); # split into name/value foreach($name,$value) { $_ = &URL_Decode($_); } # URL decode strings $$name = "$value"; # and put into %jar hash } return %jar; # return %jar hash } # ------------------------------------------------------------------------ # DB_List : Retrieve vars and execute a subroutine for each record in # the database, @fields are the var names for each field. # # example : &DB_List($datafile, $filelock, \@fields, \&rowcode, \&sortcode); # ------------------------------------------------------------------------ sub DB_List { ### Localize vars my($datafile) = $_[0]; # Database file my($filelock) = $_[1]; # File Lock Directory my(@fields) = @{$_[2]}; # Database Fields my($rowcode) = $_[3]; # routine to exec on each record my($sortcode) = $_[4]; # sort routine my(@records); # Records from Database ### Load Data if (-e $datafile) { if ($filelock) { &DB_Lock($filelock); } # File Lock open(FILE,"<$datafile") || die("DB_List : Error, Can't open $datafile. $!\n"); @records = ; # Load DB Records close(FILE); if ($filelock) { &DB_Unlock($filelock); } # File Unlock } if ($sortcode) { @records = sort { &$sortcode } @records; } # exec sort routine ### Get vars and exec subroutine for each record foreach (@records) { chomp $_; chomp $_; # chop return/nextline my(@rfields) = split(/\|/,$_); # Split record into fields ### Assign field data to variable for $i (0..$#fields) { # for each field name ${$fields[$i]} = &DB_Decode($rfields[$i]); # assign field data to var } ### Execute code for this record &$rowcode; # Execute Code } } # ------------------------------------------------------------------------ # DB_Add : Add a new record to the database and find an unused record # number. # # example : &DB_Add($datafile, $filelock, \@fields); # ------------------------------------------------------------------------ sub DB_Add { ### Localize vars my($datafile) = $_[0]; # Database file my($filelock) = $_[1]; # File Lock Directory my(@fields) = @{$_[2]}; # Database Fields my(%rnum); # Hash of record numbers my(@records); # Records from Database if ($filelock) { &DB_Lock($filelock); } # File Lock ### Load Data if (-e "$datafile") { open(FILE,"<$datafile") || die("DB_Add : Error, Can't open $datafile. $!\n"); @records = ; # Load DB Records close(FILE); } ### Find available record number foreach (@records) { chomp $_; chomp $_; # chop return/nextline my($rnum) = split(/\|/,$_); # Split record into fields $rnum{$rnum} = 1; # record record numbers } my($nnum) = 1; # Start new number from 1 while ($rnum{$nnum}) { $nnum++; } # If number is used add 1 ### Save data file with new record open(FILE,">$datafile") || die("DB_Add : Error, Can't write to $datafile. $!\n"); foreach (@records) { chomp $_; chomp $_; # chop return/nextline print FILE "$_\n"; # print out line } print FILE "$nnum|"; # New Record Number for $i (1..$#fields) { # for each field name ${$fields[$i]} = &DB_Encode(${$fields[$i]}); # Encode field for DB print FILE "${$fields[$i]}|"; # Print encoded field } print FILE "\n"; close(FILE); if ($filelock) { &DB_Unlock($filelock); } # File Unlock } # ------------------------------------------------------------------------ # DB_Save : Save a record number in the database # # example : &DB_Save($datafile, $filelock, \@fields, $record_num); # : returns 0 if record to be saved couldn't be found # ------------------------------------------------------------------------ sub DB_Save { ### Localize vars my($datafile) = $_[0]; # Database file my($filelock) = $_[1]; # File Lock Directory my(@fields) = @{$_[2]}; # Database Fields my($rnum) = int $_[3]; # Record Number to update my($rfound); # Record Found Flag my(@records); # Records from Database if ($filelock) { &DB_Lock($filelock); } # File Lock ### Load Data if (-e "$datafile") { open(FILE,"<$datafile") || die("DB_Save : Error, Can't open $datafile. $!\n"); @records = ; # Load DB Records close(FILE); } ### Save data file with new record open(FILE,">$datafile") || die("DB_Save : Error, Can't write to $datafile. $!\n"); foreach (@records) { chomp $_; chomp $_; # chop return/nextline my(@rfields) = split(/\|/,$_); # Split record into fields ### Check if this is the right record if ($rnum != $rfields[0]) { print FILE "$_\n"; } # if no match continue else { # matched, update record print FILE "$rnum|"; for $i (1..$#fields) { # for each field name ${$fields[$i]} = &DB_Encode(${$fields[$i]}); # Encode field for DB print FILE "${$fields[$i]}|"; # Print encoded field } print FILE "\n"; $rfound++; } } close(FILE); if ($filelock) { &DB_Unlock($filelock); } # File Unlock if ($rfound) { return 1; } # Record Found else { return 0; } # Record wasn't found } # ------------------------------------------------------------------------ # DB_Load : Load a record number from the database # # example : &DB_Load($datafile, $filelock, \@fields, $record_num); # ------------------------------------------------------------------------ sub DB_Load { ### Localize vars my($datafile) = $_[0]; # Database file my($filelock) = $_[1]; # File Lock Directory my(@fields) = @{$_[2]}; # Database Fields my($rnum) = int $_[3]; # Record Number to load my($rfound); # Record Found Flag my(@records); # Records from Database ### Load Data if (-e "$datafile") { if ($filelock) { &DB_Lock($filelock); } # File Lock open(FILE,"<$datafile") || die("DB_Load : Error, Can't open $datafile. $!\n"); @records = ; # Load DB Records close(FILE); if ($filelock) { &DB_Unlock($filelock); } # File Unlock } ### Find record number and assign variables for each field foreach (@records) { chomp $_; chomp $_; # chop return/nextline my(@rfields) = split(/\|/,$_); # Split record into fields ### Check if this is the right record if ($rnum == $rfields[0]) { ### Assign field data to variable for $i (0..$#fields) { # for each field name ${$fields[$i]} = &DB_Decode($rfields[$i]); # assign field data to var ${"$fields[$i]_${$fields[$i]}_selected"} = "selected"; ${"$fields[$i]_${$fields[$i]}_checked"} = "checked"; } $rfound++; } } if ($rfound) { return 1; } # Record Found else { return 0; } # Record wasn't found } # ------------------------------------------------------------------------ # DB_Del : Erase a record number from the database # # example : &DB_Del($datafile, $filelock, $record_num); # ------------------------------------------------------------------------ sub DB_Del { ### Localize vars my($datafile) = $_[0]; # Database file my($filelock) = $_[1]; # File Lock Directory my($rnum) = int $_[2]; # Record Number to load my($rfound); # Record Found Flag my(@records); # Records from Database if ($filelock) { &DB_Lock($filelock); } # File Lock ### Load Data if (-e "$datafile") { open(FILE,"<$datafile") || die("DB_Del : Error, Can't open $datafile. $!\n"); @records = ; # Load DB Records close(FILE); } ### Save Data open(FILE,">$datafile") || die("DB_Del : Error, Can't open $datafile. $!\n"); foreach (@records) { chomp $_; chomp $_; # chop return/nextline my(@rfields) = split(/\|/,$_); # Split record into fields ### Check if this is the right record if ($rnum == $rfields[0]) { $rfound++; } else { print FILE "$_\n"; } } close(FILE); if ($filelock) { &DB_Unlock($filelock); } # File Unlock if ($rfound) { return 1; } # Record Found else { return 0; } # Record wasn't found } # ---------------------------------------------------------------------------- # DB_Lock : Database locking/unlocking Perl routines. # A directory is created to flag the database as locked # # Usage : &DB_Lock("$lockdir"); # : &DB_Unlock("$lockdir"); # ---------------------------------------------------------------------------- sub DB_Lock { my($filelock) = $_[0]; # Filelock Dir my($i); # sleep counter while (!mkdir($filelock,0777)) { # attempt to make file lock (or) sleep 1; # sleep for 1 sec and try again if (++$i>50) { die("DB_Lock : Can't create filelock : $!\n"); } } } sub DB_Unlock { my($filelock) = $_[0]; # Filelock Dir rmdir($filelock); # remove file lock dir } # ---------------------------------------------------------------------------- # DB_Decode : Decode encoded DB field and return decoded string # # Usage : $decoded = &DB_Decode("$encoded"); # ---------------------------------------------------------------------------- sub DB_Decode { my($string) = $_[0]; # string to decode $string =~ s/%([A-F0-9]{2})/pack("C",hex($1))/egix; # decode string $string =~ s/\r\n/\n/gs; # replace \r\n with \n return $string; # return decoded string } # ---------------------------------------------------------------------------- # DB_Encode : Encode a DB field and return encoded string # : nextline, EOF, | and % are encoded so they # don't cause problems in the database # # Usage : $decoded = &DB_Decode("$encoded"); # ---------------------------------------------------------------------------- sub DB_Encode { my($string) = $_[0]; # string to decode $string =~ s/\r\n/\n/gs; # replace \r\n with \n $string =~ s/[\x1a\n\|\%]/uc sprintf("%%%02x",ord($&))/egx; # Encode string return $string; # return decoded string } # ---------------------------------------------------------------------------- # DB_Field : Split a record into fields and return the requested field. # This routine is used when sorting records by a specific field. # # Usage : $name = &DB_Field("name",\@fields,$record); # ---------------------------------------------------------------------------- sub DB_Field { my($fieldname) = $_[0]; # Field name to retrieve my(@fields) = @{$_[1]}; # Database Field Names my($record) = $_[2]; # Raw database row my($fieldnum); # Field number ### Use Field Name to find Field Number foreach (0..$#fields) { if ($fields[$_] eq $fieldname) { $fieldnum = $_; } } unless (defined $fieldnum) { die("DB_Field : Error, Couldn't find field name '$fieldname'\n"); } ### return decoded field from record return &DB_Decode((split(/\|/,$record))[$fieldnum]); }