#!/usr/bin/perl -- # NOTE: the above line must be changed to show the path to the # Perl interpreter on your system! Leave the #! as is, but # the path may have to be changed if yours is different. ######################################################################### # AddrBook v1.0.10 4/07/2006 # # Lets users post their addresses to a searchable address book. # # Thanks to Mike who gave me the idea for this modification of MakeBook.# # # # Copyright 2000, Kristina L. Pfaff-Harris, http://tesol.net/scripts/ # # All rights reserved. # ######################################################################### ##### Licensing: # ##### # ##### This program may be used free of charge under the following # ##### conditions: # ##### # ##### 1. All instructions and Copyright lines must remain unchanged. # ##### # ##### 2. All pages generated by the program must contain one of the # ##### following pieces of HTML code: # ##### # ##### AddrBook v1.0.10 Copyright 2000 # ##### Kristina Pfaff-Harris. It can be found at: # ##### # ##### http://www.tesol.net/scripts # ##### OR: # ##### # ##### # ##### # ##### 3. You may not sell or distribute this program. You may charge # ##### a reasonable fee for installing it for a client as long as # ##### you make it clear that you are not the author, and you are # ##### not selling the program to them: only charging for installing # ##### it. # ##### # ##### 4. You agree that this program is offered without warranty of # ##### any kind, including warranty of fitness for a particular # ##### purpose. You further agree that the author and all sites # ##### associated in any way with this program are not liable for # ##### any damage or loss incurred as a result of using this program.# ######################################################################### # # # Using the program: # # # # This program requires the files "addrbook.cgi, and a text file # # that gets written to (the "address book", usually "addrbook.txt"). # # # # In this program (the file you're looking at now), I # # have put **CHANGE** wherever the program needs to be modified. If # # your editor can search for text, you can easily find what to change # # and how to change it. You must follow the instructions for how to # # change things. This is a program, and as such, can get quite fussy # # about very small syntax errors. # # # # Permissions: The addrbook.cgi file must be "chmod 755". In # # addition, your "addrbook.txt" should be writeable by the web # # server. This usually means making it chmod 766. If you don't know how # # to do this, ask your system administrator. Note: you probably don't # # have to worry about "chmod" if you're on a Windows server. # # # # Where these files go depends on how your web server is set up. # # Sometimes, all cgi files MUST be in the "official" cgi-bin # # directory. Other times, the files can be anywhere as long as # # they end in ".cgi". Again, check with your system administrator # # to see where you need to put this. # # # ######################################################################### # I hope this program proves useful to you! Please contact me # # (http://tesol.net/scriptmail.html) for any bugs or feedback. # ######################################################################### print "Content-type: text/html\n\n"; %data = &get_data(); ######################################################################### # # # BEGIN SECTION WHERE YOU NEED TO CHANGE THINGS # # # # In this next section, there are various things that you need to # # change in order to get the program to work the way you'd like it to. # # Don't worry: each variable has an explanation of what it does and # # what you'll need to do in order to change it. Be careful of things # # like " and ; and be sure to read the instructions. If you do this, # # then you should be fine! # # # ######################################################################### # First of all, let's determine if we want to enable some debugging # information. This can be very useful when you are first setting up # the program, as it can tell you whether or not the program can find # your "addressbook" and whether it can add entries to it. If you're # having problems such as no entries showing up in the file, then # leave this alone until you've got things running. Once everything is # up and going, **CHANGE** # $debugging = "yes"; # to # $debugging = "no"; $debugging = "no"; # Next, we need to tell the program whether or not people can # view entries in your system, add entries to the system, edit entries, or # show all entries at once. By default, users can search listings, add # entries, edit entries, and show all entries at once. You have two choices # for each: "yes" or "no". # If you do not want people to look through the listings, set # $Search_Entries = "no"; # If you do not want users to add listings, set # $Add_Entries = "no"; # If you do not want users to edit listings, set # $Edit_Entries = "no"; # If you do not want users to delete listings, set # $Delete_Entries = "no"; # If you do not want users to be able to show all entries at once, set # $Show_All_Entries = "no"; # This should make it so that only you can add or view entries # using your password. You may **CHANGE** this if you like. $Search_Entries = "yes"; $Add_Entries = "no"; $Edit_Entries = "no"; $Delete_Entries = "no"; $Show_All_Entries = "no"; # $cgi_url is the full http:// web address of this script. Usually, # what I have below will work, however, on some servers, it won't work # and you will have to put in the real, full URL of the script. # **CHANGE** this only if you're getting strange things happening like # "File not found" errors when you click on one of the links in the # script. $cgi_url = "$ENV{'SCRIPT_NAME'}"; # Here, we will define our HTML header. You can monkey about with the # HTML code here so that it looks like that of your page. As you can # see in the example, you can use your own styles, etc. For more information # about what to do with $header and $footer, please check the FAQ at # http://www.tesol.net/scripts/FAQ/ . Lots of good stuff there. :) WARNING: # any " (quotes) or @ ("at" signs) must have a \ (backslash) in front # of them. Please be very careful if you modify the HTML code here -- # just one free " and the script will never run. You can put anything # you like in between the and lines. **CHANGE** this to fit in with your own site's # design. $header = qq[ Ashland Board Of Realtors - REALTORS
Ashland Area Board Of REALTORS®
"; } else { $begin = "
  • "; $end = ""; } foreach $line (@lines) { (@line) = split( /\|/, $line ); $namefield = ""; $addrfield = ""; $cityfield = ""; $entry = ""; $image = ""; foreach $field (@fields) { if ( $field eq "Image" ) { $have_image_field = 1; } } for ( $i = 0; $i <= $#fields; $i++ ) { if ( $display_type eq "horizontal" ) { $showfield = ""; $toprow .= "
  • " if $toprow_done != 1; $rowopen = ""; $rowclose = ""; } else { $showfield = "$fields[$i]: "; $toprow = ""; $rowopen = ""; $rowclose = ""; } if ( $fields[$i] =~ /Name/ ) { if ( $display_type ne "horizontal" ) { $nbeg = " "; $namefield .= " $nbeg$line[$i] $end"; } else { $nbeg = "$entry\n"; } else { $newentry .= "\n"; } } $newentry = "" . $toprow . "" . $newentry; $newentry; } sub search_alpha { $letter = "$data{'LT'}"; open( FILE, "<$addrbook" ) || &debug("Could not open address book $addrbook: $!"); @lines = sort( { lc($a) cmp lc($b) } grep( /^$letter/i, ) ); close(FILE); print "$header
    "; print &gen_alpha_list if $show_alphabetical_list ne "no"; print &gen_search_form if $show_search_form ne "no"; print &showall_link; if ( $display_type eq "horizontal" ) { $border = $table_border; $cp = $table_cellpadding; $cs = $table_cellspacing; $style = $table_style; } else { $border = 0; } print "

    REALTORS

    ]; #<-- Do not remove this line # Now define our HTML footer. As before, you may change the html # code, but be careful of " and @ signs. Please leave the copyright # notice and the address of Scripts for Educators so that other # people can find and use this program. **CHANGE** this to fit # in with your own site's design. $footer = qq[

     

    ]; #<-- Do not remove this line # $display_type is whether you want the search results to be displayed # horizontally in a table, or vertically (one field on top of the other). # To display horizontally, set $display_type = "horizontal"; # To display vertically, set $display_type = "vertical"; # **CHANGE** this if you wish. $display_type = "vertical"; # If you want to display things horizontally, here are some options for # how you want the table to look. $table_border is for the "border=" tag # of the table. $table_cellpadding is for the "cellpadding=" tag. # $table_cellspacing is for the "cellspacing=" tag. $style is for # any "style=" statements you want to make. All should be numbers, # but $table_style should include "style=" as in the example. $table_border = 1; $table_cellpadding = 0; $table_cellspacing = 0; $table_style = "style=\"font-family: Arial, sans-serif; font-size: 12px; color: #000000\""; # $formbgcolor is simply the background color you'd like for the # add entry form. You'll need to enter this in HTML "hex" format. # There are handy lookup charts all over the net where you can find # these, such as: http://www.asahi-net.or.jp/~cs7k-tktn/bgcolour/chart.html # or http://www.mowchuk.com/mtools/colchart.html # A few nice ones are: # Light grey: A8A8A8 # Light blue: C0D9D9 # Light beige: E9C2A6 # Light Yellow: EAEAAE # Light green: 8EBC8F # White: FFFFFF # **CHANGE** this to another appropriate color if you don't like # the one I've chosen below. :) $formbgcolor = "C0D9D9"; # $font is the type of font you'd like the program to use when # displaying entries, lists, etc. You may **CHANGE** this to a # different font if you like, but please remember that not all # browsers can display all fonts. $font = "Arial"; # $formfontcolor is what color you want the text to appear in the form. # This must also be entered in HTML hex format. Some examples are: # Blue: 0000FF # Black: 000000 # Grey: C0C0C0 # Red: FF0000 # White: FFFFFF $formfontcolor = "000000"; # $resultsbgcolor is what color you want the text to be highlighted in # for search results. Search results will attempt to highlight the # word you're searching for to set it off from the rest of the page. # This must also be entered in HTML hex format. Some examples are: # Blue: 0000FF # Black: 000000 # Grey: C0C0C0 # Red: FF0000 # White: FFFFFF # Yellow: FFFF66 # NOTE: Website and Email data will be highlighted, but if they appear # in a search term, they will not be presented as links. $resultsbgcolor = "ffff66"; # $resultsfontcolor is what color you want the actual highlighted text to # be in for search results. Search results will attempt to highlight the # word you're searching for to set it off from the rest of the page. # This must also be entered in HTML hex format. Some examples are: # Blue: 0000FF # Black: 000000 # Grey: C0C0C0 # Red: FF0000 # White: FFFFFF # Yellow: FFFF66 # NOTE: Website and Email data will NOT be highlighted, nor will # any entry that contains HTML. $resultsfontcolor = "000000"; # $show_reset_button is whether or not you want the "add listing" # form to have a "Reset" button or not. If you do not want to show # the reset button, **CHANGE** # $show_reset_button = "yes"; to # $show_reset_button = "no"; $show_reset_button = "yes"; # $show_raw_text_button is whether or not you want the "add listing" # form to have a "Show Raw Text" button or not. If you do not want to show # the Raw Text button, **CHANGE** # $show_raw_text_button = "yes"; to # $show_raw_text_button = "no"; $show_raw_text_button = "no"; # $show_all_entries_link is whether you want to display a link that users # can click to view all entries in the database. If you want people to # be able to view all entries at once, **CHANGE** # $show_all_entries_line = "no"; to # $show_all_entries_line = "yes"; $show_all_entries_line = "no"; # @fields is a little more tricky. This is the set of fields that # you want in your form. You get Name, Address, City, State, Zip, # Phone, Email, and Website off the top. You may add more fields # by adding lines *exactly* line the existing ones, in between the ( # and the ); . Please NOTE: There is no comma (,) after the last # field, but a comma is REQUIRED after each previous field. If you # add a field, it must be a single quote, followed by the field name, # followed by another single quote, followed by a comma unless it's # the last field, in which case, leave off the comma. The script # will break if you don't do this correctly, so please be careful, # or leave this as it is. # # IMPORTANT NOTES: If you have a field named 'Email', the program # will display it as a link to that email address. If you have a # field named 'Website', the program will display it as a link to # that website. If you have a field named 'Image', the program # will try to show that image inline on the page when it displays # that entry. # # DISPLAY: The first field will be displayed in slightly larger # font size than the rest. If any fields contain the word 'Name,' # the program assumes that it is part of a person's name, and will # tack all those fields together before displaying the entry. In # addition, if there are fields with the word 'Address' in them, # the program will tack those fields together and display them # on one line. (Hint: Don't have a field called 'Email Address' or # you may get funny results.) Fields named 'City','State', and # 'Zip' will also get tacked together onto one line. # # ALPHABETICAL ORDER: The program will use the first entry # in this list of fields to sort search results and printout results in # alphabetical order. If all the first entries are the same, it # will sort the next field, then the next. Put these fields in # the order in which you'd like it to sort. Sorry, but sorting # is going to be in ASCII order, not necessarily alphabetical order # at this point. # # IMPORTANT: Choose your fields wisely. You may not insert other fields # after you already have entries without messing everything up. If you # later find that you need an extra field in the middle of things, you # will have to re-type all entries. @fields = ( 'Last Name', 'First Name', 'Status', 'Office', 'Phone', 'Email', 'Website' ); # $local_alphabet is the alphabet you want to use for when the program # shows the letters at the top of the page. This MUST be in all upper # case or all lower case, but NOT mixed case. I realize that not everyone # uses the same alphabet as I do (American English), so if you can type # the letters of your alphabet, you may put them here. # NOTE: If you're using accented characters, and all you see when you upload # the script is ?? (question marks), try uploading the script in binary mode. # Yes, I know that usually binary mode will screw everything up so that # the script won't work, but sometimes ascii mode strips out those characters. # It's worth a try. :-) $local_alphabet = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"; # $optional_fields is a list of the fields from above that you # do not want to require. In other words, if you put "Email" here, # then the program will not force people to enter their email address, # and will let them leave it blank. If you put "Email,Website" here, # then the program will let people leave their Email and Website blank. # You should put field names in here separated by commas, as in # "Email,Website" below. # If you want people to have to fill in something for all the fields, # set $optional_fields = ""; **CHANGE** this if you want to. :) $optional_fields = "Email"; # $show_alphabetical_list lets you choose whether or not to show # a list of links to alphabetical lookups of entries in your address # book at the top of every page printed out by the program. **CHANGE** # $show_alphabetical_list to "no" if you do not want to print out this # list. $show_alphabetical_list = "yes"; # $show_search_form lets you choose whether or not to show a search # form at the top of every page printed out by the program. **CHANGE** # this to "no" if you do not want to show the search form on each page. $show_search_form = "yes"; # $show_add_form lets you choose whether or not to show the form for # adding entries on the main script page. **CHANGE** this to "no" if you do # not want to show the add entry form. $show_add_form = "no"; # $show_admin_link lets you choose whether or not to show the link to # Address Book Maintenance in small type at the bottom of every page # printed out by the program. **CHANGE** this to "no" if you do not want to # show the admin/maintenance link on each page. $show_admin_link = "no"; # $show_main_page_link lets you choose whether or not to show a link to # the main AddrBook page at the bottom of every page printed out by the # program. **CHANGE** this to "no" if you do not want to show a link # to the "Main Directory Page" on all screens. $show_main_page_link = "no"; ################################################################# # $addrbook is the system path to your address book file. This lets the # program know where to look for the file so that it can add entries to # it and search through it. # This is NOT a URL, and must NOT begin with "http://". It should # begin with "/". **CHANGE** this to the system path to your address # book file. # Sometimes, the setting I have below will work fine for you. (Try it # and see.) Otherwise, it should be something like: # $addrbook = "/home/web/yourlogin/your_web_directory/addrbook.txt"; # Or, on Windows-type systems, # $addrbook = "c:/some/folder/where/your/files/are/addrbook.txt"; $addrbook = "./addrbook.txt"; # $passwordfile is the path to a plain text file where your admin # password for this system will be stored in encrypted format. If # you can put files outside the directory where your web pages are, # you should put this file there. This file MUST start out as a plain # text file with the word "password" in it. The first time you run # this script, you should call up the admin screen like this: # http://www.yourdomain.com/addrbook.cgi?FA=Admin # and use the password "password" to log in and **CHANGE** this # password! This file must be chmod 766, or otherwise writeable by # the web server. If the password "password" does not work to log in # to the system, then most likely you have not entered this correctly, # the file is not writeable by the web server, or the file did not # start out as a plain text file with the word "password" in it. # The below value may work for you: otherwise, please set it up like # $addrbook above with the full path. For example: # $passwordfile = "/home/web/yourlogin/your_web_directory/passwordfile.txt"; # Or, on Windows-type systems, # $passwordfile = "c:/some/folder/where/your/files/are/passwordfile.txt"; $passwordfile = "./passwordfile.txt"; ################################################################# # # # That should be all you need to change! From here on # # out, it's just the program code. # # # ################################################################# # Every time the script runs, we'll check the password file for # the plain text string 'password'. If it has it, it needs to # be encrypted for the web server it's running on, so we need # to do that. &set_password; &debug( "IMPORTANT: If you're seeing this message, it's because you have \$debugging = \"yes\"; set in the addrbook.cgi script. This setting means that you'll get more information about what might be going wrong if you're having problems such as not being able to change your password, not being able to add entries to the address book, and so forth. When this script is all set up and appears to be running the way it should, set \$debugging = \"no\"; in the addrbook.cgi script and you will no longer see these messages.
    " ); &debug("Operating system is $^O"); &debug("Web Server is $ENV{'SERVER_SOFTWARE'}") if $ENV{'SERVER_SOFTWARE'}; &debug("Base path to website files is $ENV{'DOCUMENT_ROOT'}") if $ENV{'DOCUMENT_ROOT'}; &debug("Script is set as $cgi_url"); &debug("Script filename is $ENV{'SCRIPT_FILENAME'}") if $ENV{'SCRIPT_FILENAME'}; &debug("Server O/S is $^O") if $^O; &check_setup(); if ( $^O =~ /win/i ) { $opsys = "win"; } # Add a link to the admin page just in case $show_admin_link # is yes: if ( $show_admin_link =~ /^yes$/i ) { $footer = "

    " . "Address Book Maintenance" . "
    $footer"; } # Add a link to the main directory page just in case $show_main_page_link # is yes: if ( $show_main_page_link =~ /^yes$/i ) { $footer = "
    Main Directory Page
    " . "$footer"; } # If you remove this link, without replacing it with a similar # HTML comment (as above in the License section) you are in violation # of the license for this program. No, I don't have the resources to # enforce this, and I know that some people will remove it anyway. # But honestly, since you didn't have to pay for this, is the link # really too much to ask? :) # ~sigh~ Okay, I can't believe this, but many, many people don't change the # default password for address book maintenance. I guess they don't understand # that lots of people download this program, and know the default password, # and that malicious people could use it to mess up their address book. So, # we will check each time to see if the password is still "password," and # if it is, print a big notice for them to change it until they do. &has_password_been_changed(); if ( $data{'FA'} eq "Add Entry" ) { if ( $Add_Entries eq "no" ) { &authenticate; } &add_entry; } elsif ( $data{'FA'} eq "Show Raw Text" ) { if ( $Search_Entries eq "no" ) { &authenticate; } &show_text_page; } elsif ( $data{'FA'} eq "Show All Entries" ) { if ( $Show_All_Entries eq "no" ) { &authenticate; } &show_all_entries; } elsif ( $data{'FA'} eq "Edit Entry" ) { if ( $Edit_Entries eq "no" ) { &authenticate; } &edit_entries; } elsif ( $data{'FA'} eq "Delete Entry" ) { if ( $Delete_Entries eq "no" ) { &authenticate; } &delete; } elsif ( $data{'FA'} eq "Admin" ) { &admin; } elsif ( $data{'FA'} eq "Login" ) { &show_admin; } elsif ( $data{'FA'} eq "Change Password" ) { &change_password; } elsif ( $data{'LT'} =~ /^.$/ ) { if ( $Search_Entries eq "no" ) { &authenticate; } &search_alpha; } elsif ( $data{'Searchterm'} ne "" || $data{'Category'} eq "All" ) { if ( $Search_Entries eq "no" ) { &authenticate; } &search(); } else { &print_form; } # We'll probably never get to here, and it will exit by default. exit(); sub print_form { print "$header
    "; print &gen_alpha_list if $show_alphabetical_list ne "no"; print &gen_search_form if $show_search_form ne "no"; print &showall_link; print $error; print &show_add_entry_form if $show_add_form =~ /^yes$/i || &authenticate("ckonly") == 1; print "
    $footer"; exit(); } sub search { $searchfor = $data{'Searchterm'}; if ( $searchfor eq "*" || $searchfor eq "All" || $searchfor eq "" ) { $searchfor = "All"; } $searchin = $data{'Category'}; # We need to match field names with numbers... $searchfor =~ s/\|//g; $searchfor =~ s/\0//g; # Find the field we're searching for for ( $i = 0; $i <= $#fields; $i++ ) { if ( $searchin eq "All" ) { last; } if ( $searchin eq $fields[$i] ) { ; $num = $i; last; } } open( FILE, "<$addrbook" ) || &debug("Could not open address book file $addrbook: $!"); while () { # Don't grab commented lines... if ( $_ !~ /^#/ ) { if ( $num eq "" ) { if ( $_ =~ /$searchfor/i || $searchfor eq "All" ) { $_ =~ s/($searchfor)/$1<\/b>/ig if $searchfor ne "All" && $_ !~ /$1<\/b>/ig if $searchfor ne "All" && $_ !~ /<|>/; $found_line .= $_; } } } } close(FILE); if ( $found_line eq "" ) { if ( $data{'LT'} ne "" ) { $error = "No listings beginning with \"$data{'LT'}.\""; } if ( $data{'Searchterm'} ne "" ) { $error = "No listings found containing \"$data{'Searchterm'}.\""; } &print_form; } @lines = sort( split( /\n+/, $found_line ) ); print "$header
    "; print &gen_alpha_list if $show_alphabetical_list ne "no"; print &gen_search_form if $show_search_form ne "no"; print &showall_link; if ( $display_type eq "horizontal" ) { $border = $table_border; $cp = $table_cellpadding; $cs = $table_cellspacing; $style = $table_style; } else { $border = 0; } print ""; $results = &display_results(@lines); if ( $results eq "" ) { if ( $data{'LT'} ne "" ) { $error = "No listings beginning with \"$data{'LT'}.\""; } if ( $data{'Searchterm'} ne "" ) { $error = "No listings found containing \"$data{'Searchterm'}.\""; } print "$error"; } print "$results

    $footer"; exit(); } sub display_results { local (@lines) = @_; local ( $line, $namefield, $addrfield, $entry, $newentry ); if ( $display_type eq "horizontal" ) { $begin = "
    "; $end = "$fields[$i]
    "; $entry .= " $nbeg$line[$i] $end"; } } elsif ( $fields[$i] =~ /Address/ ) { if ( $display_type ne "horizontal" ) { $nbeg = " "; $addrfield .= "$nbeg$line[$i]$end"; } else { $nbeg = ""; $entry .= "$nbeg$line[$i]$end"; } } elsif ( $fields[$i] eq "Image" ) { $image_field = $fields[$i]; if ( $line[$i] ne "" ) { if ( $line[$i] !~ // ) { $image = "$begin\"$line[$i]\"$end"; } else { $image = "$begin(Search term found in image:) $line[$i]$end"; } } else { $image = " "; } if ( $display_type eq "horizontal" ) { $entry .= $image; } } elsif ( $fields[$i] =~ /City/ || $fields[$i] =~ /State/ || $fields[$i] =~ /Zip/ ) { if ( $display_type ne "horizontal" ) { $nbeg = " "; $cityfield .= "$nbeg$line[$i] $end"; } else { $nbeg = ""; $entry .= "$nbeg$line[$i] $end"; } } elsif ( $fields[$i] eq "Email" ) { if ( $line[$i] !~ // ) { $entry .= "$begin$showfield $line[$i]$end"; } else { $entry .= "$begin$showfield $line[$i]$end"; } } elsif ( $fields[$i] eq "Website" ) { $line[$i] =~ s/^\s+//g; $line[$i] =~ s/\s+$//g; if ( $line[$i] !~ /^http:\/\//i ) { $line[$i] = "http://$line[$i]"; } if ( $line[$i] !~ // ) { $entry .= "$begin$showfield $line[$i]$end"; } else { $entry .= "$begin$showfield $line[$i]$end"; } } else { $entry .= "$begin$showfield $line[$i]$end\n"; } if ( $fields[$i] eq $fields[$#fields] ) { $toprow_done = 1; } } $namefield =~ s/, $//; if ( $display_type eq "horizontal" ) { $newentry .= "
    $image $namefield
    $addrfield
    $cityfield$entry
    "; $results = &display_results(@lines); if ( $results eq "" ) { if ( $data{'LT'} ne "" ) { $error = "No listings beginning with \"$data{'LT'}.\""; } if ( $data{'Searchterm'} ne "" ) { $error = "No listings found containing \"$data{'Searchterm'}.\""; } print "$error"; } print "$results
    $footer"; exit(); } sub change_password { $opw = $data{'OldPassword'}; $npw1 = $data{'NewPassword1'}; $npw2 = $data{'NewPassword2'}; if ( $npw1 ne $npw2 ) { $error = "Error: New password doesn't match Confirm Password."; &show_admin; } if ( $opw eq "" || $npw1 eq "" || $npw2 eq "" ) { $error = "Error: You must enter your old password, and the new password twice."; &show_admin; } if ( $ENV{'SERVER_NAME'} =~ /tesol.net/i || $ENV{'SERVER_NAME'} =~ /linguistic-funland.com/i ) { $error = "Error: Password is not changeable in this demo."; &show_admin; } open( FILE, "<$passwordfile" ); $pw = ; chomp($pw); close(FILE); if ( crypt( $opw, $pw ) eq $pw ) { open( FILE, ">$passwordfile" ); print FILE crypt( $npw1, time . $$ ) . "\n"; close(FILE); $error = "Password successfully changed."; $data{'Password'} = $npw1; &show_admin; } else { $error = "Error: Incorrect old password."; &admin; } } sub add_entry { # If there's an optional field or two... # if($optional_fields ne ""){ # Get the list of what is optional into an array @opts = split( /,/, $optional_fields ); # For each of the real fields we have foreach $field (@fields) { # If the form entry for that field is blank if ( $data{$field} eq "" ) { # Check that field to see if it's optional foreach $opt (@opts) { # If it is optional, that's okay. if ( $opt eq $field ) { $okay = 1; } } # end foreach $opt } # end if($data{$field} eq "") # If we checked through our optional fields and it's NOT # an optional field, then they need to fill it out. if ( $okay != 1 && $data{$field} eq "" ) { $error = "Error: $field must be filled out."; &print_form; } } # } open( FILE, ">>$addrbook" ) || &debug("Could not write to address book $addrbook: $!"); if ( $^O !~ /win/i ) { flock( FILE, 2 ) || &debug("Could not lock address book file: $!"); } else { binmode(FILE); } seek( FILE, 0, 2 ); foreach $field (@fields) { $data{$field} =~ s/\|//g; print FILE "$data{$field}"; print FILE "|" if $field ne $fields[$#fields]; } print FILE "\n"; close(FILE); $error = "Entry successfully added!"; foreach $field (@fields) { $data{$field} = ""; } &print_form; } sub admin { if ( $error eq "" ) { $error = "Please enter your password for admin functions:"; } print "$header $error
    $footer"; exit(); } sub show_admin { &authenticate; open( FILE, "<$addrbook" ); @lines = sort( { lc($a) cmp lc($b) } ); print "$header

    "; print &gen_alpha_list if $show_alphabetical_list ne "no"; print &gen_search_form if $show_search_form ne "no"; print &showall_link; print "
    $error
    Change your password:
    Old Password:
    New Password:
    Confirm Password:

    Other Functions:
    Add Entry

    Delete or Edit entries
    "; if ( $data{'Detailed'} ne "Y" ) { print " "; } else { print " "; } print "
    \n"; foreach $line (@lines) { if ( $line !~ /^#/ ) { ( $show1, $show2 ) = ( split( /\|/, $line ) )[ 0, 1 ]; if ( $data{'Detailed'} eq "Y" ) { $show = $line; } else { $show = "$show1, $show2"; } print "\n"; } } print "
    $show
    $footer"; exit(); } sub set_password { open( FILE, "<$passwordfile" ) || &debug("Could not open password file $passwordfile: $!"); $password = ; close(FILE); if ( $password =~ /password/ ) { open( FILE, ">$passwordfile" ) || &debug( "Could not open password file $passwordfile for writing: $!"); print FILE crypt( 'password', time . $$ ) . "\n"; close(FILE); } } sub authenticate { open( FILE, "<$passwordfile" ) || &debug("Could not read password file $passwordfile: $!"); $password = ; close(FILE); chomp($password); if ( $_[0] eq "ckonly" ) { if ( crypt( $data{'Password'}, $password ) ne $password || $data{'Password'} eq "" || $password eq "" ) { return 0; } else { return 1; } } if ( crypt( $data{'Password'}, $password ) ne $password || $data{'Password'} eq "" || $password eq "" ) { $error = "Sorry, you will need the correct admin password to access this function."; &admin; } } sub delete { &authenticate; open( FILE, "+<$addrbook" ) || &debug( "Could not open address book file $addrbook for read/write: $!"); if ( $^O !~ /win/i ) { flock( FILE, 2 ) || &debug("Could not lock address book file: $!"); } else { binmode(FILE); } @lines = ; foreach $line (@lines) { $line =~ s/\s+$//; $data{'Line'} =~ s/\s+$//; if ( $line ne "$data{'Line'}" ) { $newfile .= "$line\n"; } } truncate( FILE, length($newfile) ); seek( FILE, 0, 0 ); print FILE "$newfile"; close(FILE); $error = "Entry deleted."; &show_admin; } sub show_text_page { open( FILE, "<$addrbook" ); @lines = sort(); close(FILE); print "
    ";
        foreach $line (@lines) {
            print $line if $line !~ /^#/;
        }
        print "
    "; } sub debug { if ( $debugging eq 'yes' ) { print "DEBUGGING INFO: $_[0]
    "; } } sub get_data { local ($string); # get data if ( $ENV{'REQUEST_METHOD'} eq 'GET' ) { $string = $ENV{'QUERY_STRING'}; } else { read( STDIN, $string, $ENV{'CONTENT_LENGTH'} ); } # split data into name=value pairs @data = split( /&/, $string ); # split into name=value pairs in associative array foreach (@data) { split( /=/, $_ ); $_[0] =~ s/\+/ /g; # plus to space $_[0] =~ s/%00//g; # We don' need no steenking nulls :) $_[0] =~ s/%0a/newline/g; $_[0] =~ s/%(..)/pack("c", hex($1))/ge; # hex to alphanumeric if ( defined( $data{ $_[0] } ) ) { $data{ $_[0] } .= "\0"; $data{ $_[0] } .= "$_[1]"; } else { $data{"$_[0]"} = $_[1]; } } # translate special characters foreach ( keys %data ) { $data{"$_"} =~ s/\+/ /g; # plus to space $data{"$_"} =~ s/%00//g; # We don' need no steenking nulls :) $data{"$_"} =~ s/%0a/newline/g; $data{"$_"} =~ s/%(..)/pack("c", hex($1))/ge; # hex to alphanumeric } %data; # return associative array of name=value } sub gen_alpha_list { local ( @letters, $list, $let ); @letters = split( //, "$local_alphabet" ); $list = "
    "; foreach $let (@letters) { $list .= "[$let] "; } $list .= ""; $list .= "
    " if $show_search_form eq "no"; $list; } sub gen_search_form { local ( $search, $field ); $search = "
    Search for

    "; $search; } sub show_all_entries { open( FILE, "<$addrbook" ) || &debug( "Could not open address book $addrbook to show all entries: $!"); my (@lines) = sort( { lc($a) cmp lc($b) } grep( !/^#/, ) ); close(FILE); print "$header
    "; print &gen_alpha_list if $show_alphabetical_list ne "no"; print &gen_search_form if $show_search_form ne "no"; print &showall_link; if ( $display_type eq "horizontal" ) { $border = $table_border; $cp = $table_cellpadding; $cs = $table_cellspacing; $style = $table_style; } else { $border = 0; } print ""; $results = &display_results(@lines); if ( $results eq "" ) { if ( $data{'LT'} ne "" ) { $what = "No listings beginning with \"$data{'LT'}.\""; } if ( $data{'Searchterm'} ne "" ) { $what = "No listings found containing \"$data{'Searchterm'}.\""; } print "$what"; } print "$results

    $footer"; } sub showall_link { $showall_link = "
    Show all entries.
    \n" if $show_all_entries_line eq "yes"; $showall_link; } sub edit_entries { # Save results. if ( $data{FA2} eq "Save" ) { # save results open( FILE, "+<$addrbook" ) || &debug( "Could not open address book $addrbook for read/write to save changes: $!" ); if ( $opsys eq "unix" ) { flock( FILE, 2 ) || &debug("Could not lock $addrbook: $!"); } else { binmode(FILE); } while () { # Get the existing record... @oldfields = split( /\|/, $_ ); # First, we're going to go through the old fields that were sent from # the form, so that we know what the original record looked like. The # idea here is, if we take all the data in the "-old" fields # and put them together with a | between them in the order of our # original @fields, what we end up with *should* be exactly the same # as the line with the entries we're trying to replace. foreach $field (@fields) { $test_oldline .= $data{"$field-old"}; $test_oldline .= "|"; } # Oh, and take the extra | off the end. $test_oldline =~ s/\|$//; # Also, take the newline off the end of the line from the file, since # we don't have one on our new line. $_ =~ s/\s+$//sg; print "\n"; $test_oldline =~ s/\s+$//sg; print "\n\n"; # And if they match... if ( $test_oldline eq $_ ) { # print "They match!"; # Put the *new* ones into a line separated by | foreach $field (@fields) { # Bug fix for IE for the Mac: for some reason, that # browser sticks in an extra carriage return character. # Huh ... wha? Who knows. Anyway, we'll just strike off # any spaces, carriage returns, or newline characters there # might be just in case. Sheesh. $data{$field} =~ s/\s+$//g; $data{$field} =~ s/\r\n+$//g; $data{$field} =~ s/\r+$//g; $data{$field} =~ s/\n+$//g; $newline .= $data{$field}; $newline .= "|"; } $newline =~ s/\|$//; # Add a newline back on the end $newline = "$newline\n"; } else { # Or, if it's just an old entry, put it back the way it was. $newline = "$_\n"; } # Append that to our new file contents... $newfile .= $newline; # and erase newline and test_oldline so we can start over. $newline = ""; $test_oldline = ""; } # Now, newfile should contain all the old records and the new # record we just changed. So, let's rewrite the file. truncate( FILE, length($newfile) ); seek( FILE, 0, 0 ); print FILE $newfile; close(FILE); print "$header
    Changes saved


    Old EntryNew Entry
    "; foreach $field (@fields) { $old = $data{"$field-old"}; print "$field: $old
    \n"; } print "
    "; foreach $field (@fields) { print "$field: $data{$field}
    \n"; } print "
    $footer"; exit(); } # Generate Form # @ fields (fields on the form) # optional_fields (separated by commas) print "$header
    Edit this Entry


    "; print "
    \n"; # $data{'Line'} entry to edit chomp( $data{'Line'} ); @values = split( /\|/, $data{'Line'} ); $i = 0; foreach $field (@fields) { print "\n"; $i++; } print "
    $field:
    $footer"; exit(); } sub has_password_been_changed { # I don't want this warning for my demo. :-) return if $ENV{'SERVER_NAME'} =~ /\.linguistic-funland\.com$/i || $ENV{'SERVER_NAME'} =~ /\.tesol\.net$/i; # Get the password from the password file... open( PW, "<$passwordfile" ) || &debug("Could not open password file $passwordfile: $!"); my ($pw) = ; close(PW); chomp($pw); if ( crypt( 'password', $pw ) eq $pw || $pw eq "password" ) { $header .= "
    WARNING - WARNING - WARNING!!!
    It appears as though you have NOT changed your password. This is dangerous because it means that anyone can just type \"password\" and do things to your AddrBook. Please change your password to something that is not easy to guess.

    You will see this message on every page until you change the password to something other than \"password\".
    "; } } sub show_add_entry_form { my $aef = "
    $error
    Add a Listing!

    "; foreach $field (@fields) { $aef .= "\n"; } $aef .= "
    $field:
    "; if ( $show_reset_button eq "yes" ) { $aef .= ""; } if ( $show_raw_text_button eq "yes" ) { $aef .= ""; } $aef .= "
    "; $aef; } sub check_setup { &debug("Path to address book is set as $addrbook"); unless ( -f $addrbook ) { print "$header FATAL ERROR: Sorry, but the path you set as \$addrbook ($addrbook) isn't correct. This program cannot function without an address book file. Please correct \$addrbook in the script and try again. $footer"; exit(); } unless ( -w $addrbook ) { print "$header FATAL ERROR: Sorry, but your address book file ($addrbook) is not writeable. This means that the program cannot add, edit, or delete entries. Please check that $addrbook is chmod 766 or otherwise ensure that the server can write to it. You may check the FAQ for more information about \"chmod\" and how to do it. You may also need to change the \$passwordfile variable in the script. $footer"; exit(); } &debug("Path to password file is set as $passwordfile"); unless ( -f $passwordfile ) { print "$header FATAL ERROR: Sorry, but the path you set as \$passwordfile ($passwordfile) isn't correct. This program cannot function without a password file. Please correct \$passwordfile in the script and try again. $footer"; exit(); } unless ( -w $passwordfile ) { print "$header FATAL ERROR: Sorry, but your password file ($passwordfile) is not writeable. This means that the program cannot change or encrypt your password. Please check that $passwordfile is chmod 766 or otherwise ensure that the server can write to it. You may check the FAQ for more information about \"chmod\" and how to do it. You may also need to change the \$passwordfile variable in the script. $footer"; exit(); } }