[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[cobalt-users] asking for allot - need cgi pro
- Subject: [cobalt-users] asking for allot - need cgi pro
- From: "hirsh -e-skwirtz" <hirsheskwirtz@xxxxxxxxxxx>
- Date: Wed Apr 4 13:59:14 2001
- List-id: Mailing list for users to share thoughts on Cobalt products. <cobalt-users.list.cobalt.com>
we have a script we actualy paid $79.00 for that will let people add change
and update contend on a web page from their own browser -
i need to add a function to the script -
i need to add e-mailing me upon web page mods -
here is a link to the functioning script
http://www.netbloomsdirect.com/my_flower_shop.html
here is the snippet i was given to make the script work
note - the word was to install:
a good place to put that email code would be
on or about line 95 right below this code:
#================================
# thank_you_page
#================================
sub thank_you_page
{
<<>>>
here is the email code - note the mail program path in the script
we are on a raq4 and the path is /usr/sbin/sendmail
when i insert this snippet with the wrong path the script still works but
the email does not
when i change the script to reflect the correct path, all i get is internal
server error
# --- begin ---
$mailprog ='/usr/lib/sendmail'; # change this if necessary
$to_addr ='user@xxxxxxxxxxxx'; # your email address
$from_addr ='anonymous@xxxxxxxx'; # who this will come from
$to_subject='Whatever you want'; # subject of email
open (MAIL, "|$mailprog $recipient") || die "sendmail error\n";
print MAIL "From: $from_addr\n";
print MAIL "To: $to_addr\n";
print MAIL "Subject: $to_subject\n\n";
print MAIL " $FORM{'HOMELINK'} was updated\n";
close (MAIL);
# --- end ---
<<>>>>
here is the original script>>>>
#!/usr/bin/perl
############################################################################
# Program: fastpage3.cgi
# By: IEXP.COM
# Version: 3.0 build 212
# Date: 02/10/2001
#
# This software is protected copyright laws. Your license
# gives you specific useage rights. You may not
# reproduce or in any was distribute this software
# other than electronic backup of licensed production copies
# without express written permission of Internet Expressions.
# Violators will be punished to the full extent that the law
# allows.
#
# (c)1997-2001 Internet Expressions, Inc. (IEXP.COM)
############################################################################
require 5.003;
require '/home/sites/site12/web/edit-secure/sample_free_page1.pl';
##############################################
# Main Program
##############################################
&setenv;
&read_multipart;
&mode_select;
exit;
############################################################################
# Subroutine area
############################################################################
#================================
# mode_select
#================================
sub mode_select
{
# Redirect if this is an old-style link.
if (($ENV{'QUERY_STRING'} =~ /cfg/) && ($URL{'mode'} eq "") &&
!($ENV{'QUERY_STRING'} =~ /config/))
{
&redirect("?config=$ENV{'QUERY_STRING'}");
}
if ($URL{'config'} eq "") # No config file
{
&diagnostics;
}
elsif ($URL{'mode'} eq "") # havent logged in yet
{
&read_config;
&login_form;
}
elsif ($URL{'mode'} eq "form")
{
&read_config;
&authenticate;
&scan_fp_fields;
&edit_form;
}
elsif ($URL{'mode'} eq "write")
{
&check_changes; # verify all required info is filled in
&backup_original; # create backup file
&process_changes; # loop over all fields and update page
&thank_you_page;
}
else
{
&header("Unknown Mode");
print "unknown error<br>\n";
&footer;
}
return;
}
#================================
# setenv
#================================
sub setenv
{
@REGISTRY = (pack("C10",51,46,48),
pack("C10",107,86),
pack("C10",79,103),
pack("C10",48));
®srv;
return;
}
#================================
# thank_you_page
#================================
sub thank_you_page
{
&header("Changes complete");
if ($FORM{'HOMELINK'} ne "")
{
$returnlink = "<a href=\"$FORM{'HOMELINK'}\">Click here to return to
your page.</a>";
}
else
{
$returnlink = "";
}
print <<EOM;
<div align="center"><center>
<table border="0" cellpadding="0" cellspacing="0">
<tr align="left">
<td width="100%"><font face="Arial,Helvetica,Sans Serif" size="+1">
<strong>Updates Completed</strong>
</font></td>
</tr>
<tr align="left">
<td width="100%"><font face="Arial,Helvetica,Sans Serif"
size="-1"><br>
$num_marked_updates update(s) to your page completed
successfully.<br>
<strong>NOTE:</strong> You may need to reload the updated page in
your browser to see the changes.<br>
<br>
$returnlink
</font></td>
</tr>
</table>
</center></div>
EOM
&footer;
return;
}
#================================
# check_changes
#================================
sub check_changes
{
# Loop over vars. For each type selected to update,
# see if there are values for required fields
$fieldcnt = $FORM{'FIELDS'};
$num_updates = 0;
$num_errors = 0;
$num_marked_updates = 0;
for ($x = 0; $x < $fieldcnt; $x++)
{
# See if box is checked
$updatevar = "UPDATE$x";
$fieldvar = "MARKER$x";
if ($FORM{$updatevar} eq "Yes")
{
$num_marked_updates++;
($page,$ftype,$fname) = split(/\|/,$FORM{$fieldvar});
@PATH = split(/\//, $page);
pop @PATH;
$localpath = join("/",@PATH);
if ($ftype eq "TITLE")
{
$valuevar = "VALUE$x";
if ($FORM{$valuevar} eq "")
{
@INCOMPLETE[$num_errors] = "No value specified for $fname";
$num_errors++;
}
}
elsif ($ftype eq "TEXT")
{
$valuevar = "VALUE$x";
if ($FORM{$valuevar} eq "")
{
@INCOMPLETE[$num_errors] = "No value specified for $fname";
$num_errors++;
}
}
elsif ($ftype eq "LIST")
{
$valuevar = "VALUE$x";
if ($FORM{$valuevar} eq "")
{
@INCOMPLETE[$num_errors] = "No list items specified for $fname";
$num_errors++;
}
}
elsif ($ftype eq "COMMENT")
{
$valuevar = "VALUE$x";
if ($FORM{$valuevar} eq "")
{
@INCOMPLETE[$num_errors] = "No value specified for $fname";
$num_errors++;
}
}
elsif ($ftype eq "EMAIL")
{
$valuevar = "VALUE$x";
if ($FORM{$valuevar} eq "")
{
@INCOMPLETE[$num_errors] = "No value specified for $fname";
$num_errors++;
}
}
# HIDDEN fields are allowed to be null
elsif ($ftype eq "CSS")
{
$valuevar = "TEXT$x";
$valuevar2 = "LINK$x";
if (($FORM{$valuevar} eq "") || ($FORM{$valuevar2} eq ""))
{
@INCOMPLETE[$num_errors] = "Text and Link styles are required for
$fname";
$num_errors++;
}
}
elsif ($ftype eq "DLFILE")
{
$valuevar = "CURRENT$x";
$valuevar2 = "NEWFILE$x";
$valuevar2src = "NEWFILE$x.src";
$valuevar3 = "OVERWRITE$x";
if (($FORM{$valuevar} eq "") && ($FORM{$valuevar2} eq ""))
{
@INCOMPLETE[$num_errors] = "No filename or new upload specified for
$fname";
$num_errors++;
}
elsif (($FORM{$valuevar2} ne "") && ($FORM{$valuevar3} eq "NO"))
{
# check if file exists
if (-e "$localpath/$filepath/$FORM{$valuevar2src}")
{
@INCOMPLETE[$num_errors] = "The file you are uploading
($FORM{$valuevar2src}) already exists on the server";
$num_errors++;
}
}
# check filetypes here
if ($FORM{$valuevar2} ne "") #Uploading a file...
{
@ALLOW = split(/;/,$DLuploads);
$ext_found = 0;
for ($aidx = 0; $aidx < @ALLOW; $aidx++)
{
$extension = @ALLOW[$aidx];
if ($FORM{$valuevar2src} =~ /$extension$/i)
{
$ext_found = 1;
}
}
if ($ext_found == 0)
{
@INCOMPLETE[$num_errors] = "The file you are uploading
($FORM{$valuevar2src}) for $fname is not an allowed filetype";
$num_errors++;
}
} #end check filetype (DLFILE)
} #end if DLFILE
elsif (($ftype eq "BODY") || ($ftype eq "BACKGROUND"))
{
$valuevar = "CURRENT$x"; # Old filename
$valuevar2 = "NEWIMAGE$x"; # Upload content (binary)
$valuevar2src = "NEWIMAGE$x.src"; # Filename
# check filetypes here
if ($FORM{$valuevar2} ne "") #Uploading a file...
{
@ALLOW = split(/;/,$IMGuploads);
$ext_found = 0;
for ($aidx = 0; $aidx < @ALLOW; $aidx++)
{
$extension = @ALLOW[$aidx];
if ($FORM{$valuevar2src} =~ /$extension$/i)
{
$ext_found = 1;
}
}
if ($ext_found == 0)
{
@INCOMPLETE[$num_errors] = "The file you are uploading
($FORM{$valuevar2src}) for $fname is not an allowed filetype";
$num_errors++;
}
} #end check filetype (IMG)
} #end if BODY or BACKGROUND
elsif (($ftype eq "IMG") || ($ftype eq "IMGADV"))
{
$valuevar = "CURRENT$x"; # Old filename
$valuevar2 = "NEWIMAGE$x"; # Upload content (binary)
$valuevar2src = "NEWIMAGE$x.src"; # Filename
if (($FORM{$valuevar} eq "") && ($FORM{$valuevar2} eq ""))
{
@INCOMPLETE[$num_errors] = "No filename or new upload specified for
$fname";
$num_errors++;
}
# check filetypes here
if ($FORM{$valuevar2} ne "") #Uploading a file...
{
@ALLOW = split(/;/,$IMGuploads);
$ext_found = 0;
for ($aidx = 0; $aidx < @ALLOW; $aidx++)
{
$extension = @ALLOW[$aidx];
if ($FORM{$valuevar2src} =~ /$extension$/i)
{
$ext_found = 1;
}
}
if ($ext_found == 0)
{
@INCOMPLETE[$num_errors] = "The file you are uploading
($FORM{$valuevar2src}) for $fname is not an allowed filetype";
$num_errors++;
}
} #end check filetype (IMG)
} #end if IMG or IMGADV
}
}
# If the user didn't check any boxes
if ($num_marked_updates == 0)
{
@INCOMPLETE[$num_errors] = "No fields were marked for updates";
$num_errors++;
}
# If errors occurred
if ($num_errors > 0)
{
&header("Form Incomplete");
print "<blockquote>";
print "$num_errors error(s) or incomplete field(s) found in your
submission:<br><br>\n";
print "<ul>\n";
for ($j = 0; $j < @INCOMPLETE; $j++)
{
print "<li> $INCOMPLETE[$j]</li>\n";
}
print "</ul>\n";
print "<br>Please click your browser's <em>Back</em> button to make the
necessary corrections to the form.<br>\n";
print "</blockquote>";
&footer;
exit;
}
return;
}
#================================
# backup_original
#================================
sub process_changes
{
$fieldcnt = $FORM{'FIELDS'};
$num_updates = 0;
for ($x = 0; $x < $fieldcnt; $x++)
{
# See if box is checked
$updatevar = "UPDATE$x";
$fieldvar = "MARKER$x";
if ($FORM{$updatevar} eq "Yes")
{
($page,$ftype,$fname) = split(/\|/,$FORM{$fieldvar});
@PATH = split(/\//, $page);
pop @PATH;
$localpath = join("/",@PATH);
$value = "default value";
if ($ftype eq "TEXT")
{
$valuevar = "VALUE$x";
$value = $FORM{$valuevar};
# Strip out any bad chars
$form_var = "HTMLFORMAT$x";
if ($FORM{$form_var} ne "Yes")
{
$value = &strip_html_tags($value);
}
$form_var = "PGHFORMAT$x";
if ($FORM{$form_var} eq "Yes")
{
$value =~ s/\n/<br>/g;
}
} # End TEXT
if ($ftype eq "SMALLTEXT")
{
$valuevar = "VALUE$x";
$value = $FORM{$valuevar};
# Strip out any bad chars
$value = &strip_html_tags($value);
} # End SMALLTEXT
if ($ftype eq "COMMENT")
{
$valuevar = "VALUE$x";
$value = $FORM{$valuevar};
# Strip out any bad chars
$value = &strip_html_tags($value);
$value = "<!--$value-->";
} # End COMMENT
elsif ($ftype eq "TITLE")
{
$valuevar = "VALUE$x";
$value = $FORM{$valuevar};
# Strip out any bad chars
$value = &strip_html_tags($value);
$value = "<title>$value</title>";
} # End TITLE
elsif ($ftype eq "LIST")
{
$valuevar = "VALUE$x";
$value = $FORM{$valuevar};
$value = &strip_html_tags($value);
$typevar = "LISTTYPE$x";
$listtype = $FORM{$typevar};
$newlist = "";
if ($listtype eq "UL")
{$newlist = "<ul>";}
elsif ($listtype eq "OL")
{$newlist = "<ol type=\"1\">";}
elsif ($listtype eq "OLA")
{$newlist = "<ol type=\"A\">";}
elsif ($listtype eq "OLI")
{$newlist = "<ol type=\"I\">";}
# Now make each line into an <li>
@ListItems = split(/\n/,$value);
for ($lx = 0; $lx < @ListItems; $lx ++)
{
$newlist = $newlist."<li>".@ListItems[$lx];
}
if ($listtype eq "UL")
{$newlist = "$newlist</ul>";}
else
{$newlist = "$newlist</ol>";}
$value = $newlist;
} # End TITLE
elsif ($ftype eq "HIDDEN")
{
$valuevar = "VALUE$x";
$value = $FORM{$valuevar};
# Strip out any bad chars
$value = &strip_html_tags($value);
$value = "<input type=\"Hidden\" name=\"$fname\"
value=\"$value\">";
} # End TITLE
elsif ($ftype eq "EMAIL")
{
$valuevar = "VALUE$x";
$value = $FORM{$valuevar};
# Strip out any bad chars
$value = &strip_html_tags($value);
$value = "<a href=\"mailto:$value\";>$value</a>";
} # End EMAIL
elsif ($ftype eq "DLFILE")
{
$uploadvar = "NEWFILE$x";
$uploadfile = "NEWFILE$x.src";
$tag_options = "";
if ($FORM{$uploadvar} ne "") # uploading a new file
{
# write new file
open (NEWFILE, ">$localpath/$filepath/$FORM{$uploadfile}") || die
&error(55);
binmode NEWFILE;
print NEWFILE $FORM{$uploadvar};
close(NEWFILE);
chmod(0777,"$localpath/$filepath/$FORM{$uploadfile}");
}
else
{
$uploadfile = "CURRENT$x";
# determine local filename
@PATHx = split(/\//, $FORM{$uploadfile});
$localfname = pop @PATHx;
}
# construct download tag
if ($FORM{$uploadvar} ne "") # new upload
{$value = "<a
href=\"$filepath/$FORM{$uploadfile}\">$FORM{$uploadfile}</a>";}
else
{$value = "<a
href=\"$FORM{$uploadfile}\">$localfname</a>";}
} # end DLFILE
elsif (($ftype eq "IMG") || ($ftype eq "IMGADV"))
{
$uploadvar = "NEWIMAGE$x";
$uploadfile = "NEWIMAGE$x.src";
$tag_options = "";
if ($FORM{$uploadvar} ne "") # uploading a new file
{
# write new file
open (NEWFILE, ">$localpath/$imagepath/$FORM{$uploadfile}") || die
&error(55);
binmode NEWFILE;
print NEWFILE $FORM{$uploadvar};
close(NEWFILE);
chmod(0777,"$localpath/$imagepath/$FORM{$uploadfile}");
}
else
{$uploadfile = "CURRENT$x";}
# Read attributes
$form_var = "JSNAME$x";
if ($FORM{$form_var} ne "")
{$tag_options = "$tag_options
name=\"$FORM{$form_var}\"";}
$form_var = "ALIGN$x";
if ($FORM{$form_var} ne "")
{$tag_options = "$tag_options
align=\"$FORM{$form_var}\"";}
$form_var = "VALIGN$x";
if ($FORM{$form_var} ne "")
{$tag_options = "$tag_options
valign=\"$FORM{$form_var}\"";}
$form_var = "BORDER$x";
if ($FORM{$form_var} ne "")
{$tag_options = "$tag_options
border=\"$FORM{$form_var}\"";}
$form_var = "HSPACE$x";
if ($FORM{$form_var} ne "")
{$tag_options = "$tag_options
hspace=\"$FORM{$form_var}\"";}
$form_var = "VSPACE$x";
if ($FORM{$form_var} ne "")
{$tag_options = "$tag_options
vspace=\"$FORM{$form_var}\"";}
$form_var = "ALTTEXT$x";
if ($FORM{$form_var} ne "")
{$tag_options = "$tag_options
alt=\"$FORM{$form_var}\"";}
$form_var = "WIDTH$x";
if ($FORM{$form_var} ne "")
{$tag_options = "$tag_options
width=\"$FORM{$form_var}\"";}
$form_var = "HEIGHT$x";
if ($FORM{$form_var} ne "")
{$tag_options = "$tag_options
height=\"$FORM{$form_var}\"";}
# construct img tag
if ($FORM{$uploadvar} ne "") # new upload
{$value = "<img
src=\"$imagepath/$FORM{$uploadfile}\"$tag_options>";}
else
{$value = "<img
src=\"$FORM{$uploadfile}\"$tag_options>";}
# Is this a link?
$form_var = "URL$x";
if ($FORM{$form_var} ne "")
{$value = "<a href=\"$FORM{$form_var}\">$value</a>";}
} # End IMG and IMGADV
elsif (($ftype eq "BODY") || ($ftype eq "BACKGROUND"))
{
$uploadvar = "NEWIMAGE$x";
$uploadfile = "NEWIMAGE$x.src";
if ($FORM{$uploadvar} ne "") # uploading a new file
{
# write new file
open (NEWFILE, ">$localpath/$imagepath/$FORM{$uploadfile}") || die
&error(55);
binmode NEWFILE;
print NEWFILE $FORM{$uploadvar};
close(NEWFILE);
chmod(0777,"$localpath/$imagepath/$FORM{$uploadfile}");
}
else
{$uploadfile = "CURRENT$x";}
$tag_options = "<body";
$form_var = "TEXT$x";
if ($FORM{$form_var} ne "")
{$tag_options = "$tag_options
text=\"$FORM{$form_var}\"";}
$form_var = "LINK$x";
if ($FORM{$form_var} ne "")
{$tag_options = "$tag_options
link=\"$FORM{$form_var}\"";}
$form_var = "VLINK$x";
if ($FORM{$form_var} ne "")
{$tag_options = "$tag_options
vlink=\"$FORM{$form_var}\"";}
$form_var = "ALINK$x";
if ($FORM{$form_var} ne "")
{$tag_options = "$tag_options
alink=\"$FORM{$form_var}\"";}
$form_var = "BGCOLOR$x";
if ($FORM{$form_var} ne "")
{$tag_options = "$tag_options
bgcolor=\"$FORM{$form_var}\"";}
$form_var = "TOPMARGIN$x";
if ($FORM{$form_var} ne "")
{$tag_options = "$tag_options
topmargin=\"$FORM{$form_var}\" marginheight=\"$FORM{$form_var}\"";}
$form_var = "LEFTMARGIN$x";
if ($FORM{$form_var} ne "")
{$tag_options = "$tag_options
leftmargin=\"$FORM{$form_var}\" marginwidth=\"$FORM{$form_var}\"";}
$form_var = "NEWIMAGE$x";
if ($FORM{$form_var} ne "")
{
$tag_options = "$tag_options
background=\"$imagepath/$FORM{$uploadfile}\"";
}
else
{
$tag_options = "$tag_options
background=\"$FORM{$uploadfile}\"";
}
$form_var = "ONLOAD$x";
if ($FORM{$form_var} ne "")
{$tag_options = "$tag_options
onLoad=\"$FORM{$form_var}\"";}
$tag_options = "$tag_options>";
$value = $tag_options;
} # End Body
elsif ($ftype eq "CSS")
{
$tag_options = "\n<style type=\"text/css\">\n<!--\n";
$form_var = "TEXT$x";
if ($FORM{$form_var} ne "")
{$tag_options = "$tag_options A: {$FORM{$form_var}}\n";}
$form_var = "LINK$x";
if ($FORM{$form_var} ne "")
{$tag_options = "$tag_options A:link
{$FORM{$form_var}}\n";}
$form_var = "ACTIVE$x";
if ($FORM{$form_var} ne "")
{$tag_options = "$tag_options A:active
{$FORM{$form_var}}\n";}
$form_var = "VISITED$x";
if ($FORM{$form_var} ne "")
{$tag_options = "$tag_options A:visited
{$FORM{$form_var}}\n";}
$form_var = "HOVER$x";
if ($FORM{$form_var} ne "")
{$tag_options = "$tag_options A:hover
{$FORM{$form_var}}\n";}
$tag_options = "$tag_options-->\n</style>\n";
$value = $tag_options;
} # End CSS
# Options are not used right now
$options = "";
# Submit info to be updated
&update_fp_field($page, $ftype, $fname, $options, $value);
}
}
return;
}
#================================
# strip_html_tags
#================================
sub strip_html_tags
{
($string) = @_;
while (index($string,"<") != -1)
{
$renegade_tag_idx = index($string,"<");
$renegade_tagend_idx = index($string,">",$renegade_tag_idx+1);
if ($renegade_tagend_idx != -1)
{
# remove tag
$string = substr($string,0,$renegade_tag_idx)."
".substr($string,$renegade_tagend_idx+1);
}
else
{
# just substitute the "<" char with <
$string = substr($string,0,$renegade_tag_idx)." <
".substr($string,$renegade_tag_idx+1);
}
}
return $string;
}
#================================
# backup_original
#================================
sub backup_original
{
@PATH = split(/\//, $CONFIG{'PAGE'});
$local_file = pop @PATH;
$localpath = join("/",@PATH);
$bakfile = "$local_file.fp_bak";
if (-e "$localpath/$bakfile") # If backup already exists
{
unlink("$localpath/$bakfile"); # delete it
}
# Create new backup
# open (SRC,"$CONFIG{'PAGE'}") || die &error(40);
# open (BAK,"$localpath/$bakfile") || die &error(51);
# while ($line = <SRC>)
# {
# print BAK $line;
# }
# close(SRC);
# close(BAK);
return;
}
#================================
# scan_fp_fields
#================================
sub scan_fp_fields
{
$file = $CONFIG{'PAGE'};
$num_fields = 0;
&error(40) unless (-e $file);
open (INFILE, "<$file") || die "Can't open $file for reading...";
@lines = <INFILE>;
close(INFILE);
$file_contents = join("",@lines);
$file_contents =~ s/\r//g;
$linecnt = @lines;
$len = length($file_contents);
# Find all valid FP tags...
$start = 0;
while ($done == 0)
{
$new_tag_start = index($file_contents,"<!--FP",$start);
# get index of new tag
if ($new_tag_start == -1)
{
$done = 1;
}
else
{
# get end of new tag
$new_tag_end =
index($file_contents,">",$new_tag_start);
if ($new_tag_end == -1)
{
# Malformed tag -- ignore
}
# grab all text in this tag
$new_tag =
substr($file_contents,$new_tag_start,($new_tag_end-$new_tag_start)+1);
if (!$TAGLIST{$new_tag})
{
$TAGLIST{$new_tag} = 1;
}
elsif ($TAGLIST{$new_tag} != 2)
{
@FIELDS[$num_fields]=$new_tag;
$num_fields++;
#print "New Tag Pair: $new_tag\n";
}
# chars to skip before continuing search
$start = $new_tag_end;
}
}
} # end scan_fp_fields
#================================
# update_fp_field
#================================
sub update_fp_field
{
($file, $fieldtype, $fieldname, $options, $value) = @_;
# Open file for reading ...
open (INFILE, "<$file") || die &error(40);
@lines = <INFILE>;
close(INFILE);
$file_contents = join("",@lines);
$file_contents =~ s/\r//g;
# find and separate content around tags in document...
$tag_index = index($file_contents,"<!--FP:$fieldtype:$fieldname");
# first tag
&error(71) if ($tag_index == -1) ;
$intro_content = substr($file_contents,0,$tag_index);
$tag_index =
index($file_contents,"<!--FP:$fieldtype:$fieldname",$tag_index+1); # second
tag
$trail_content =
substr($file_contents,index($file_contents,">",$tag_index+1)+1);
# Archive old file ...
if ($createbackups == 1)
{
unlink($file.".FPold");
rename($file,$file.".FPold");
}
# Write new file ...
open (NEWFILE, ">$file") || die &error(50);
print NEWFILE $intro_content;
if ($addnewline == 1)
{print NEWFILE "\n";}
print NEWFILE "<!--FP:$fieldtype:$fieldname-->";
if ($addnewline == 1)
{print NEWFILE "\n";}
print NEWFILE "$value";
if ($addnewline == 1)
{print NEWFILE "\n";}
print NEWFILE "<!--FP:$fieldtype:$fieldname-->";
if ($addnewline == 1)
{print NEWFILE "\n";}
print NEWFILE $trail_content;
close (NEWFILE);
chmod(0777,$file);
return;
} # end update_fp_field
#================================
# read_config
#================================
sub read_config
{
open (CONFIG,"$home/$URL{'config'}") || die &error(10);
$username = <CONFIG>;
$username =~ s/\n//g;
$username =~ s/\r//g;
$password = <CONFIG>;
$password =~ s/\n//g;
$password =~ s/\r//g;
$page = <CONFIG>;
$page =~ s/\n//g;
$page =~ s/\r//g;
&error(40) unless (-e $page);
&error(11) unless ($username && $password && $page);
$CONFIG{'USERNAME'} = $username;
$CONFIG{'PASSWORD'} = $password;
$CONFIG{'PAGE'} = $page;
$crypt_pwd = crypt($FORM{'PASSWORD'},$REGISTRY[1]);
$crypt_user = crypt($FORM{'USERNAME'},$REGISTRY[1]);
$crypt_addr = crypt($ENV{'REMOTE_ADDR'},$REGISTRY[1]);
@PATH = split(/\//, $page);
pop @PATH;
$imgpath = join("/",@PATH);
$CONFIG{'IMGPATH'} = $imgpath;
$tmpfile = "fp_temp.tmp";
open (TMP, ">$imgpath/$imagepath/$tmpfile") || &error(55);
close (TMP);
unlink ("$imgpath/$imagepath/$tmpfile") || &error(56);
open (TMP, ">$imgpath/$filepath/$tmpfile") || &error(55);
close (TMP);
unlink ("$imgpath/$filepath/$tmpfile") || &error(56);
return;
}
sub regsrv
{
# Valid license ?
if ($license eq crypt($domain,$REGISTRY[1]))
{$REGISTRY[3] = 1;}
elsif ($license eq crypt($domain,$REGISTRY[2]))
{$REGISTRY[3] = 2;}
else
{&error(12);}
# Valid domain ?
if ($REGISTRY[3] == 2)
{
if (($ENV{'HTTP_HOST'} ne "") &&
!($ENV{'HTTP_HOST'} =~ /$domain/i))
{&error(13);}
}
return;
}
#================================
# authenticate
#================================
sub authenticate
{
# If we dont have all the info
if (($FORM{'USERNAME'} eq "") ||
($FORM{'PASSWORD'} eq "") ||
($FORM{'PRIVATE'} eq ""))
{
&login_form;
}
if (($FORM{'USERNAME'} eq $CONFIG{'USERNAME'}) &&
($FORM{'PASSWORD'} eq $CONFIG{'PASSWORD'}))
{
$crypt_pwd = crypt($FORM{'PASSWORD'},$REGISTRY[1]);
$crypt_user = crypt($FORM{'USERNAME'},$REGISTRY[1]);
return;
}
if (($FORM{'USERNAME'} eq $adminuser) &&
($FORM{'PASSWORD'} eq $adminpass))
{
$crypt_pwd = crypt($FORM{'PASSWORD'},$REGISTRY[1]);
$crypt_user = crypt($FORM{'USERNAME'},$REGISTRY[1]);
return;
}
&error(20);
}
#================================
# cc_fp_field
#================================
sub cc_fp_field
{
($file, $fieldtype, $fieldname) = @_;
open (INFILE, "<$file") || die "Can't open file for reading...";
@lines = <INFILE>;
close(INFILE);
$file_contents = join("",@lines);
$file_contents =~ s/\r//g;
# find and separate content around tags in document...
$tag_index = index($file_contents,"<!--FP:$fieldtype:$fieldname");
# first tag
if ($tag_index == -1)
{
print "Specified tag not found in document.\nAborting.\n";
return;
}
$cc_content =
substr($file_contents,index($file_contents,">",$tag_index+1)+1);
$tag_index = index($cc_content,"<!--FP:$fieldtype:$fieldname"); #
second tag
if ($tag_index == -1)
{
print "Specified END tag not found in document.\nAborting.\n";
return;
}
$cc_content = substr($cc_content,0,$tag_index);
$cc_content =~ s/x0d//g;
return $cc_content;
}
#================================
# edit_form
#================================
sub edit_form
{
&header("NetbloomsDirect Web Page Editor");
$numfields = @FIELDS;
print <<EOM;
<div align="center"><center>
<table width="500">
<td width="100%">
<font face="Arial,Helvetica,Sans Serif" size="-1">
$help
</td>
</table>
<form method="post" action="$scriptname?config=$URL{'config'}&mode=write"
enctype="multipart/form-data">
<input type="Hidden" name="TOKEN" value="$crypt_user">
<input type="Hidden" name="KEY" value="$crypt_pwd">
<input type="Hidden" name="PRIVATE" value="$crypt_addr">
<input type=hidden name="FIELDS" value="$numfields">
<input type="Hidden" name="HOMELINK" value="$FORM{'HOMELINK'}">
<table border="0" cellpadding="2" cellspacing="1"
bgcolor="$tablebordercolor" width="540">
<tr align="center" bgcolor="$tablebgcolor2">
<td><font face="Arial,Helvetica,Sans Serif"
size="-1"><strong>Update</strong></font></td>
<td><font face="Arial,Helvetica,Sans Serif"
size="-1"><strong>Field</strong></font></td>
<td><font face="Arial,Helvetica,Sans Serif"
size="-1"><strong>Value</strong></font></td>
</tr>
EOM
for($x = 0;$x < @FIELDS; $x++)
{
@FIELDS[$x] =~ /<!--FP:(.*):(.*)-->/;
$ftype = $1;
$fname = $2;
print <<EOM;
<tr bgcolor="$tablebgcolor3" valign="middle">
<td align="center"><input type="Checkbox" name=UPDATE$x value=\"Yes\">
<input type="hidden" name="MARKER$x"
value="$CONFIG{'PAGE'}|$ftype|$fname"></td>
<td nowrap><font face="Arial,Helvetica,Sans Serif"
size="-1">$fname</td>
EOM
if ($ftype eq "TEXT")
{
# CC routine here
$cc_content = &cc_fp_field($CONFIG{'PAGE'},$ftype,$fname);
# Strip out unwanted HTML here
$cc_content =~ s/<br>/\n/g;
$cc_content =~ s/<\/textarea>/<\/textarea>/g;
print <<EOM;
<td width="80%"><textarea name="VALUE$x" cols="50" rows="5"
wrap="virtual">$cc_content</textarea><br>
<font face="Arial,Helvetica,Sans Serif" size="-1">
<input type="Checkbox" name="PGHFORMAT$x" value="Yes"> Retain paragraph
formatting<br>
<input type="Checkbox" name="HTMLFORMAT$x" value="Yes"> Allow HTML
code<br>
</td>
</tr>
EOM
}
if ($ftype eq "SMALLTEXT")
{
# CC routine here
$cc_content = &cc_fp_field($CONFIG{'PAGE'},$ftype,$fname);
# Strip out unwanted HTML here
$cc_content =~ s/[\n\r\t]//g;
$cc_content = &strip_html_tags($cc_content);
print <<EOM;
<td width="80%"><input type="text" name="VALUE$x" size="45"
value="$cc_content"></td>
</tr>
EOM
}
if ($ftype eq "TITLE")
{
$cc_content = &cc_fp_field($CONFIG{'PAGE'},$ftype,$fname);
# Strip out chars etc. from cc_content here
$cc_content =~ s/[\n\r]//g;
if ($cc_content =~ /<title>(.*)<\/title>/i)
{$cc_content = &strip_html_tags(&pull_until_quote($1));}
print <<EOM;
<td width="80%"><input size="50" type="Text" name="VALUE$x"
value="$cc_content"></td>
</tr>
EOM
}
if ($ftype eq "CSS")
{
$cc_content = &cc_fp_field($CONFIG{'PAGE'},$ftype,$fname);
# Strip out chars etc. from cc_content here
$cc_content =~ s/<!--//g;
$cc_content =~ s/-->//g;
if ($cc_content =~ /A: {(.*)}.*/i)
{$cc_text = $1;}
if ($cc_content =~ /A:active {(.*)}/i)
{$cc_active = $1;}
if ($cc_content =~ /A:link {(.*)}/i)
{$cc_link = $1;}
if ($cc_content =~ /A:visited {(.*)}/i)
{$cc_visited = $1;}
if ($cc_content =~ /A:hover {(.*)}/i)
{$cc_hover = $1;}
print <<EOM;
<td width="80%"><table>
<tr align="right">
<td><font face="Arial,Helvetica,Sans Serif"
size="-1">A: </td>
<td><input type="text" name="TEXT$x" size="40"
maxlength="255" value="$cc_text"></td>
</tr>
<tr align="right">
<td><font face="Arial,Helvetica,Sans Serif"
size="-1">A:link </td>
<td><input type="text" name="LINK$x" size="40"
maxlength="255" value="$cc_link"></td>
</tr>
<tr align="right">
<td><font face="Arial,Helvetica,Sans Serif"
size="-1">A:active </td>
<td><input type="text" name="ACTIVE$x" size="40"
maxlength="255" value="$cc_active"></td>
</tr>
<tr align="right">
<td><font face="Arial,Helvetica,Sans Serif"
size="-1">A:visited </td>
<td><input type="text" name="VISITED$x"
size="40" maxlength="255" value="$cc_visited"></td>
</tr>
<tr align="right">
<td><font face="Arial,Helvetica,Sans Serif"
size="-1">A:hover </td>
<td><input type="text" name="HOVER$x" size="40"
maxlength="255" value="$cc_hover"></td>
</tr>
</table></td>
</tr>
EOM
}
if ($ftype eq "EMAIL")
{
$cc_content = &cc_fp_field($CONFIG{'PAGE'},$ftype,$fname);
# Strip out chars etc. from cc_content here
if ($cc_content =~ /href="mailto:(.*)">(.*)<\/a>/i)
{$cc_content = &pull_until_quote($1);}
print <<EOM;
<td width="80%"><input size="45" type="Text" name="VALUE$x"
value="$cc_content"></td>
</tr>
EOM
}
if ($ftype eq "LIST")
{
$cc_content = &cc_fp_field($CONFIG{'PAGE'},$ftype,$fname);
# Strip out chars etc. from cc_content here
if ($cc_content =~ /ol type="(.*)"/i)
{
#ordered type
$cc_listtype = &pull_until_quote($1);
if ($cc_listtype eq "1")
{
$cc_listlabel = "Numeric (1,2,3, ...)";
}
elsif ($cc_listtype eq "A")
{
$cc_listlabel = "Alphabetic (A,B,C, ...)";
}
elsif ($cc_listtype eq "I")
{
$cc_listlabel = "Roman Numeral (I,II,III,..)";
}
else
{
$cc_listtype = "";
$cc_listlabel = "Bulleted";
}
}
else
{
$cc_listtype = "UL";
$cc_listlabel = "Bulleted";
}
$cc_content =~ s/<ul>//g;
$cc_content =~ s/<\/ul>//g;
$cc_content =~ s/<ol>//g;
$cc_content =~ s/<ol type=".*">//g;
$cc_content =~ s/<\/ol>//g;
$cc_content =~ s/<\/li>//g;
$cc_content =~ s/\r//g;
$cc_content =~ s/\t//g;
$cc_content =~ s/\n//g;
$cc_content =~ s/<li>/\n/g;
print <<EOM;
<td width="80%"><font face="Arial,Helvetica,Sans Serif"
size="-1"><textarea name="VALUE$x" cols="50" rows="4"
wrap="off">$cc_content</textarea><br>
List Type: <select name="LISTTYPE$x">
<option
value="$cc_listtype">$cc_listlabel</option>
<option value="UL">Bulleted</option>
<option value="OL">Numeric (1,2,3, ...)</option>
<option value="OLA">Alphabetic (A,B,C, ...)</option>
<option value="OLI">Roman Numeral (I,II,III,..)</option>
</select>
</td>
</tr>
EOM
}
if ($ftype eq "HIDDEN")
{
$cc_content = &cc_fp_field($CONFIG{'PAGE'},$ftype,$fname);
# Strip out chars etc. from cc_content here
if ($cc_content =~ /value="(.*)"/i)
{$cc_content = &pull_until_quote($1);}
print <<EOM;
<td width="80%"><input size="45" type="Text" name="VALUE$x"
value="$cc_content"></td>
</tr>
EOM
}
if ($ftype eq "COMMENT")
{
$cc_content = &cc_fp_field($CONFIG{'PAGE'},$ftype,$fname);
# Strip out chars etc. from cc_content here
$cc_content =~ s/<!--//g;
$cc_content =~ s/-->//g;
print <<EOM;
<td width="80%"><input size="45" type="Text" name="VALUE$x"
value="$cc_content"></td>
</tr>
EOM
}
if ($ftype eq "DLFILE")
{
$cc_content = &cc_fp_field($CONFIG{'PAGE'},$ftype,$fname);
# Strip out chars etc. from cc_content here
if ($cc_content =~ /href="(.*)"/i)
{$cc_src = &pull_until_quote($1);}
print <<EOM;
<td width="80%"><table border="0" cellpadding="1" cellspacing="0"
width="100%">
<tr>
<td align="right" width="40%"><font
face="Arial,Helvetica,Sans Serif" size="-1">Current:</td>
<td><input type="text" name="CURRENT$x"
size="30" maxlength="255" value="$cc_src"></td>
</tr>
<tr>
<td align="right"><font
face="Arial,Helvetica,Sans Serif" size="-1">Upload new:</td>
<td><input type="File" name="NEWFILE$x"></td>
</tr>
<tr valign="top">
<td align="right"><font
face="Arial,Helvetica,Sans Serif" size="-1">Overwrite if the new file you
are uploading already exists on the server?</td>
<td><font face="Arial,Helvetica,Sans Serif"
size="-1"><input type="Radio" name="OVERWRITE$x" value="YES"> Yes <br><input
type="Radio" name="OVERWRITE$x" value="NO" checked> No</td>
</tr>
</table></td>
</tr>
EOM
}
if ($ftype eq "BODY")
{
$cc_content = &cc_fp_field($CONFIG{'PAGE'},$ftype,$fname);
# Strip out chars etc. from cc_content here
if ($cc_content =~ /text="(.*)"/i)
{$cc_text = &pull_until_quote($1);}
if ($cc_content =~ /link="(.*)"/i)
{$cc_link = &pull_until_quote($1);}
if ($cc_content =~ /vlink="(.*)"/i)
{$cc_vlink = &pull_until_quote($1);}
if ($cc_content =~ /alink="(.*)"/i)
{$cc_alink = &pull_until_quote($1);}
if ($cc_content =~ /bgcolor="(.*)"/i)
{$cc_bgcolor = &pull_until_quote($1);}
if ($cc_content =~ /topmargin="(.*)"/i)
{$cc_topmargin = &pull_until_quote($1);}
if ($cc_content =~ /leftmargin="(.*)"/i)
{$cc_leftmargin = &pull_until_quote($1);}
if ($cc_content =~ /background="(.*)"/i)
{$cc_background = &pull_until_quote($1);}
if ($cc_content =~ /onLoad="(.*)"/i)
{$cc_onLoad = &pull_until_quote($1);}
print <<EOM;
<td width="80%"><table border="0" cellpadding="1" cellspacing="0"
width="100%">
<tr>
<td width="50%" valign="top"><table border="0" width="100%"
cellpadding="0" cellspacing="1">
<tr>
<td align="right"><font
face="Arial,Helvetica,Sans Serif" size="-1">TEXT:</td>
<td><input type="text" name="TEXT$x" size="8"
maxlength="255" value="$cc_text"></td>
</tr>
<tr>
<td align="right"><font
face="Arial,Helvetica,Sans Serif" size="-1">LINK:</td>
<td><input type="text" name="LINK$x" size="8"
maxlength="255" value="$cc_link"></td>
</tr>
<tr>
<td align="right"><font
face="Arial,Helvetica,Sans Serif" size="-1">VLINK:</td>
<td><input type="text" name="VLINK$x" size="8"
maxlength="255" value="$cc_vlink"></td>
</tr>
<tr>
<td align="right"><font
face="Arial,Helvetica,Sans Serif" size="-1">ALINK:</td>
<td><input type="text" name="ALINK$x" size="8"
maxlength="255" value="$cc_alink"></td>
</tr>
</table></td>
<td width="50%" valign="top"><table border="0" width="100%"
cellpadding="0" cellspacing="1">
<tr>
<td align="right"><font
face="Arial,Helvetica,Sans Serif" size="-1">BGCOLOR:</td>
<td><input type="text" name="BGCOLOR$x"
size="8" maxlength="255" value="$cc_bgcolor"></td>
</tr>
<tr>
<td align="right"><font
face="Arial,Helvetica,Sans Serif" size="-1">Top Margin:</td>
<td><input type="text" name="TOPMARGIN$x"
size="3" maxlength="255" value="$cc_topmargin"></td>
</tr>
<tr>
<td align="right"><font
face="Arial,Helvetica,Sans Serif" size="-1">Left Margin:</td>
<td><input type="text" name="LEFTMARGIN$x"
size="3" maxlength="255" value="$cc_leftmargin"></td>
</tr>
</table></td>
</tr>
<tr>
<td align="right"><font
face="Arial,Helvetica,Sans Serif" size="-1">Current Background Image:</td>
<td><input type="text" name="CURRENT$x"
size="30" maxlength="255" value="$cc_background"></td>
</tr>
<tr>
<td align="right"><font
face="Arial,Helvetica,Sans Serif" size="-1">Upload new:</td>
<td><input type="File" name="NEWIMAGE$x"></td>
</tr>
<tr>
<td align="right"><font
face="Arial,Helvetica,Sans Serif" size="-1">Javascript onLoad( )
Function:</td>
<td><input type="text" name="ONLOAD$x" size="30"
maxlength="255" value="$cc_onLoad"></td>
</tr>
</table>
</td>
</tr>
EOM
# Clear vars for next tag
$cc_text = $cc_link = $cc_vlink = "";
$cc_alink = $cc_bgcolor = $cc_topmargin = "";
$cc_leftmargin = $cc_onLoad = "";
}
if ($ftype eq "BACKGROUND")
{
$cc_content = &cc_fp_field($CONFIG{'PAGE'},$ftype,$fname);
# Strip out chars etc. from cc_content here
if ($cc_content =~ /text="(.*)"/i)
{$cc_text = &pull_until_quote($1);}
if ($cc_content =~ /link="(.*)"/i)
{$cc_link = &pull_until_quote($1);}
if ($cc_content =~ /vlink="(.*)"/i)
{$cc_vlink = &pull_until_quote($1);}
if ($cc_content =~ /alink="(.*)"/i)
{$cc_alink = &pull_until_quote($1);}
if ($cc_content =~ /bgcolor="(.*)"/i)
{$cc_bgcolor = &pull_until_quote($1);}
if ($cc_content =~ /topmargin="(.*)"/i)
{$cc_topmargin = &pull_until_quote($1);}
if ($cc_content =~ /leftmargin="(.*)"/i)
{$cc_leftmargin = &pull_until_quote($1);}
if ($cc_content =~ /background="(.*)"/i)
{$cc_background = &pull_until_quote($1);}
if ($cc_content =~ /onLoad="(.*)"/i)
{$cc_onLoad = &pull_until_quote($1);}
print <<EOM;
<td width="80%"><table border="0" cellpadding="1" cellspacing="0"
width="100%">
<input type="hidden" name="TEXT$x" size="8"
maxlength="255" value="$cc_text">
<input type="hidden" name="LINK$x" size="8"
maxlength="255" value="$cc_link">
<input type="hidden" name="VLINK$x" size="8"
maxlength="255" value="$cc_vlink">
<input type="hidden" name="ALINK$x" size="8"
maxlength="255" value="$cc_alink">
<tr>
<td align="right"><font
face="Arial,Helvetica,Sans Serif" size="-1">BGCOLOR:</td>
<td><input type="text" name="BGCOLOR$x"
size="8" maxlength="255" value="$cc_bgcolor"></td>
</tr>
<tr>
<td align="right"><font
face="Arial,Helvetica,Sans Serif" size="-1">Current Background Image:</td>
<td><input type="text" name="CURRENT$x"
size="30" maxlength="255" value="$cc_background"></td>
</tr>
<tr>
<td align="right"><font
face="Arial,Helvetica,Sans Serif" size="-1">Upload new:</td>
<td><input type="File" name="NEWIMAGE$x"></td>
</tr>
<input type="hidden" name="TOPMARGIN$x" size="3"
maxlength="255" value="$cc_topmargin">
<input type="hidden" name="LEFTMARGIN$x" size="3"
maxlength="255" value="$cc_leftmargin">
<input type="hidden" name="ONLOAD$x" size="30"
maxlength="255" value="$cc_onLoad">
</table></td>
</tr>
EOM
# Clear vars for next tag
$cc_text = $cc_link = $cc_vlink = "";
$cc_alink = $cc_bgcolor = $cc_topmargin = "";
$cc_leftmargin = $cc_onLoad = "";
}
if ($ftype eq "IMGADV")
{
$cc_content = &cc_fp_field($CONFIG{'PAGE'},$ftype,$fname);
# Strip out chars etc. from cc_content here
if ($cc_content =~ /src="(.*)"/i)
{$cc_src = &pull_until_quote($1);}
if ($cc_content =~ /border="(.*)"/i)
{$cc_border = &pull_until_quote($1);}
if ($cc_content =~ /vspace="(.*)"/i)
{$cc_vspace = &pull_until_quote($1);}
if ($cc_content =~ /hspace="(.*)"/i)
{$cc_hspace = &pull_until_quote($1);}
if ($cc_content =~ /align="(.*)"/i)
{$cc_align = &pull_until_quote($1);}
if ($cc_content =~ /name="(.*)"/i)
{$cc_jsname = &pull_until_quote($1);}
if ($cc_content =~ /href="(.*)"/i)
{$cc_href = &pull_until_quote($1);}
if ($cc_content =~ /alt="(.*)"/i)
{$cc_alttext = &pull_until_quote($1);}
if ($cc_content =~ /width="(.*)"/i)
{$cc_width = &pull_until_quote($1);}
if ($cc_content =~ /height="(.*)"/i)
{$cc_height = &pull_until_quote($1);}
print <<EOM;
<td width="80%">
<table border="0" cellpadding="1" cellspacing="0" width="100%">
<tr>
<td align="right"><font
face="Arial,Helvetica,Sans Serif" size="-1">Current:</td>
<td><input type="text" name="CURRENT$x"
size="30" maxlength="255" value="$cc_src"></td>
</tr>
<tr>
<td align="right"><font
face="Arial,Helvetica,Sans Serif" size="-1">Upload new:</td>
<td><input type="File" name="NEWIMAGE$x"></td>
</tr>
<tr>
<td colspan="2"><table border="0" width="100%"
cellpadding="0" cellspacing="1">
<td valign="top"><table border="0"
width="100%" cellpadding="0" cellspacing="1">
<tr>
<td align="right"><font face="Arial,Helvetica,Sans Serif"
size="-1">Border:</td>
<td><input type="Text" name="BORDER$x" size="2"
value="$cc_border"></td>
</tr>
<tr>
<td align="right"><font face="Arial,Helvetica,Sans Serif"
size="-1">Width:</td>
<td><input type="Text" name="WIDTH$x" size="2"
value="$cc_width"></td>
</tr>
<tr>
<td align="right"><font face="Arial,Helvetica,Sans Serif"
size="-1">Height:</td>
<td><input type="Text" name="HEIGHT$x" size="2"
value="$cc_height"></td>
</tr>
<tr>
<td align="right"><font face="Arial,Helvetica,Sans Serif"
size="-1">Name (JavaScript):</td>
<td><input type="Text" name="JSNAME$x" size="8"
value="$cc_jsname"></td>
</tr>
</table></td>
<td valign="top"><table border="0"
width="100%" cellpadding="0" cellspacing="1">
<tr>
<td align="right"><font face="Arial,Helvetica,Sans Serif"
size="-1">Alignment:</td>
<td><select name="ALIGN$x">
<option value="$cc_align">$cc_align</option>
<option value="None">None</option>
<option value="Left">Left</option>
<option value="Middle">Middle</option>
<option value="Right">Right</option>
<option value="Top">Top</option>
<option value="Bottom">Bottom</option>
<option value="Baseline">Baseline</option>
</select></td>
</tr>
<tr>
<td align="right"><font face="Arial,Helvetica,Sans Serif"
size="-1">Horizontal Space:</td>
<td><input type="Text" name="HSPACE$x" size="2"
value="$cc_hspace"></td>
</tr>
<tr>
<td align="right"><font face="Arial,Helvetica,Sans Serif"
size="-1">Vertical Space:</td>
<td><input type="Text" name="VSPACE$x" size="2"
value="$cc_vspace"></td>
</tr>
</table></td>
</table></td>
</tr>
<tr>
<td align="right"><font face="Arial,Helvetica,Sans Serif"
size="-1">Alternate Text:</td>
<td><input size="35" type="Text" name="ALTTEXT$x"
value="$cc_alttext"></td>
</tr>
<tr>
<td align="right"><font face="Arial,Helvetica,Sans Serif"
size="-1">Web Link (optional):</td>
<td><input size="45" type="Text" name="URL$x" value="$cc_href"></td>
</tr>
</table>
</td>
</tr>
EOM
# clear all vars in case there are multiple same-type fields
$cc_src = $cc_border = $cc_vspace = $cc_hspace = $cc_jsname = "";
$cc_align = $cc_href = $cc_alttext = $cc_width = $cc_height = "";
}
if ($ftype eq "IMG")
{
$cc_content = &cc_fp_field($CONFIG{'PAGE'},$ftype,$fname);
# Strip out chars etc. from cc_content here
if ($cc_content =~ /src="(.*)"/i)
{$cc_src = &pull_until_quote($1);}
if ($cc_content =~ /border="(.*)"/i)
{$cc_border = &pull_until_quote($1);}
if ($cc_content =~ /vspace="(.*)"/i)
{$cc_vspace = &pull_until_quote($1);}
if ($cc_content =~ /hspace="(.*)"/i)
{$cc_hspace = &pull_until_quote($1);}
if ($cc_content =~ /align="(.*)"/i)
{$cc_align = &pull_until_quote($1);}
if ($cc_content =~ /name="(.*)"/i)
{$cc_jsname = &pull_until_quote($1);}
if ($cc_content =~ /href="(.*)"/i)
{$cc_href = &pull_until_quote($1);}
if ($cc_content =~ /alt="(.*)"/i)
{$cc_alttext = &pull_until_quote($1);}
if ($cc_content =~ /width="(.*)"/i)
{$cc_width = &pull_until_quote($1);}
if ($cc_content =~ /height="(.*)"/i)
{$cc_height = &pull_until_quote($1);}
print <<EOM;
<td width="80%">
<table border="0" cellpadding="1" cellspacing="0" width="100%">
<tr>
<td align="right"><font
face="Arial,Helvetica,Sans Serif" size="-1">Current:</td>
<td><input type="text" name="CURRENT$x"
size="30" maxlength="255" value="$cc_src"></td>
</tr>
<tr>
<td align="right"><font
face="Arial,Helvetica,Sans Serif" size="-1">Upload new:</td>
<td><input type="File" name="NEWIMAGE$x"></td>
</tr>
</table>
<input type="hidden" name="BORDER$x" value="$cc_border">
<input type="hidden" name="WIDTH$x" value="$cc_width">
<input type="hidden" name="HEIGHT$x" value="$cc_height">
<input type="hidden" name="ALIGN$x" value="$cc_align">
<input type="hidden" name="HSPACE$x" value="$cc_hspace">
<input type="hidden" name="VSPACE$x" value="$cc_vspace">
<input type="hidden" name="JSNAME$x" value="$cc_jsname">
<input type="hidden" name="ALTTEXT$x" value="$cc_alttext">
<input type="hidden" name="URL$x" value="$cc_href">
</td>
</tr>
EOM
# clear all vars in case there are multiple same-type fields
$cc_src = $cc_border = $cc_vspace = $cc_hspace = $cc_jsname = "";
$cc_align = $cc_href = $cc_alttext = $cc_width = $cc_height = "";
}
}
print <<EOM;
<tr bgcolor="$tablebgcolor2">
<td colspan="3"><input type="Submit" value="Submit Changes"></td>
</tr>
</form>
</table>
</center></div>
EOM
&footer;
exit;
}
#================================
# pull_until_quote
#================================
sub pull_until_quote
{
($somevalue) = @_;
if (index($somevalue,"\"") != -1)
{
$somevalue = substr($somevalue,0,index($somevalue,"\""));
}
return $somevalue;
}
#================================
# login_form
#================================
sub login_form
{
&header("NetbloomsDirect Login Form");
print <<EOM;
<div align="center"><center>
<table border="0" cellpadding="20" cellspacing="1" width="440">
<tr>
<td>
<font face="Arial,Helvetica,Sans Serif" size="-1">
The NetbloomsDirect Web Page Editor requires a username and password to
edit the specified web page.
</font>
</td>
</tr>
</table>
<table border="0" cellpadding="20" cellspacing="1"
bgcolor="$tablebordercolor" width="440">
<form method="post" enctype="multipart/form-data"
action="$scriptname?config=$URL{'config'}&mode=form">
<input type="Hidden" name="PRIVATE" value="$crypt_addr">
<input type="Hidden" name="HOMELINK" value="$ENV{'HTTP_REFERER'}">
<tr>
<td width="50%" bgcolor="$tablebgcolor1">
<font face="Arial,Helvetica,Sans Serif" size="-1">
Please enter the Username and Password you were provided and click
"Continue."
</font>
</td>
<td width="50%" bgcolor="$tablebgcolor2"><table>
<tr>
<td align="right"><font face="Arial,Helvetica,Sans Serif"
size="-1"><strong>Username:</strong></font></td>
<td><input type="Text" name="USERNAME" size="18"></td>
</tr>
<tr>
<td align="right"><font face="Arial,Helvetica,Sans Serif"
size="-1"><strong>Password:</strong></font></td>
<td><input type="Password" name="PASSWORD" size="18"></td>
</tr>
<tr>
<td colspan="2"><input type="Submit" value="Continue"></td>
</tr>
</form>
</table></td>
</tr>
</form>
</table>
</center></div>
EOM
&footer;
exit;
}
#================================
# diagnostics
#================================
sub diagnostics
{
&header("NetbloomsDirect Web Page Diagnostics");
if ($license eq crypt($domain,$REGISTRY[1]))
{
$lic_type =
pack("C22",82,101,103,105,115,116,101,114,101,100,32,73,83,80,32,
76,105,99,101,110,115,101);
}
elsif ($license eq crypt($domain,$REGISTRY[2]))
{
$lic_type = pack("C19",83,105,110,103,108,101,32,83,105,116,101,32,
76,105,99,101,110,115,101);
}
else
{
$lic_type =
pack("C40",77,105,115,115,105,110,103,32,111,114,32,105,110,118,97,108,105,100,32,108,105,99,101,110,115,101);
}
print <<EOM;
<div align="center"><center>
<table border="0" cellpadding="3" cellspacing="1"
bgcolor="$tablebordercolor" width="540">
<tr bgcolor="$tablebgcolor1" align="left">
<td colspan="2"><font face="Arial,Helvetica,Sans Serif" size="-1">
The following are the current settings for NetbloomsDirect Page Edit
$version.
Please see the configuration guide for information on each of
these settings, what they do and how to change them.<br>
</td>
</tr>
<tr bgcolor="$tablebgcolor2" align="left">
<td><font face="Arial,Helvetica,Sans Serif" size="-1">home</font></td>
<td><font face="Arial,Helvetica,Sans Serif" size="-1">$home</font></td>
</tr>
<tr bgcolor="$tablebgcolor2" align="left">
<td><font face="Arial,Helvetica,Sans Serif" size="-1">domain</font></td>
<td><font face="Arial,Helvetica,Sans Serif" size="-1">$domain</font></td>
</tr>
<tr bgcolor="$tablebgcolor2" align="left">
<td><font face="Arial,Helvetica,Sans Serif" size="-1">license</font></td>
<td><font face="Arial,Helvetica,Sans Serif"
size="-1">$lic_type</font></td>
</tr>
<tr bgcolor="$tablebgcolor2" align="left">
<td><font face="Arial,Helvetica,Sans Serif"
size="-1">scriptname</font></td>
<td><font face="Arial,Helvetica,Sans Serif"
size="-1">$scriptname</font></td>
</tr>
<tr bgcolor="$tablebgcolor2" align="left">
<td><font face="Arial,Helvetica,Sans Serif"
size="-1">imagepath</font></td>
<td><font face="Arial,Helvetica,Sans Serif"
size="-1">$imagepath</font></td>
</tr>
<tr bgcolor="$tablebgcolor2" align="left">
<td><font face="Arial,Helvetica,Sans Serif" size="-1">filepath</font></td>
<td><font face="Arial,Helvetica,Sans Serif"
size="-1">$filepath</font></td>
</tr>
<tr bgcolor="$tablebgcolor2" align="left">
<td><font face="Arial,Helvetica,Sans Serif"
size="-1">IMGuploads</font></td>
<td><font face="Arial,Helvetica,Sans Serif"
size="-1">$IMGuploads</font></td>
</tr>
<tr bgcolor="$tablebgcolor2" align="left">
<td><font face="Arial,Helvetica,Sans Serif"
size="-1">DLuploads</font></td>
<td><font face="Arial,Helvetica,Sans Serif"
size="-1">$DLuploads</font></td>
</tr>
<tr bgcolor="$tablebgcolor2" align="left">
<td><font face="Arial,Helvetica,Sans Serif"
size="-1">addnewline</font></td>
<td><font face="Arial,Helvetica,Sans Serif"
size="-1">$addnewline</font></td>
</tr>
<tr bgcolor="$tablebgcolor2" align="left">
<td><font face="Arial,Helvetica,Sans Serif"
size="-1">createbackups</font></td>
<td><font face="Arial,Helvetica,Sans Serif"
size="-1">$createbackups</font></td>
</tr>
<tr bgcolor="$tablebgcolor2" align="left">
<td><font face="Arial,Helvetica,Sans Serif"
size="-1">header_file</font></td>
<td><font face="Arial,Helvetica,Sans Serif"
size="-1">$header_file</font></td>
</tr>
<tr bgcolor="$tablebgcolor2" align="left">
<td><font face="Arial,Helvetica,Sans Serif"
size="-1">footer_file</font></td>
<td><font face="Arial,Helvetica,Sans Serif"
size="-1">$footer_file</font></td>
</tr>
</table>
</center></div>
EOM
&footer;
exit;
}
#================================
# redirect
#================================
sub redirect
{
local($url) = @_;
print "Location: $url\n";
print "Content-type: text/html\n\n";
exit;
}
#================================
# read_multipart
#================================
# Version: 2.0
# Date: January 14, 2001
# By: IEXP.COM
#
# This software is protected
# copyright laws. You may not
# reproduce or in any was
# distribute this software
# without express written
# permission of Internet
# Expressions, Inc. Violators
# will be punished to the full
# extent of the law.
#================================
# To write a file from uploaded data:
#
# open (NEWFILE, ">$filename");
# binmode NEWFILE;
# print NEWFILE $FORM{'FILE-DATA'};
# close(NEWFILE);
#
#================================
sub read_multipart
{
binmode STDIN;
$| = 1;
$debug = 0;
read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
$boundary = substr($buffer,0,index($buffer,"\n"));
$boundary =~ s/[\n\r\t\s]+$//g;
$endboundary = $boundary."--";
$buffer = substr($buffer,0,index($buffer,$endboundary));
@fields = split(/$boundary/, $buffer);
if ($debug == 1)
{
print "Content-type: text/html\n\n";
$tempvarcnt = @fields;
print "<br>Debug mode.<br>Found $tempvarcnt form vars.<br>\n";
print "Boundary is $boundary<br>\n";
print "End Boundary is $endboundary<br>\n";
}
for ($i = 1; $i<@fields; $i++)
{
$field = @fields[$i];
# Test this with a MAC - may need to be \n\n for MACs
$separator_idx = index($field,"\r\n\r\n");
if ($separator_idx == -1)
{
$separator_idx = index($field,"\n\n");
}
$field_header = substr($field,0,$separator_idx);
$value = substr($field,$separator_idx+1);
$value = substr($value,3); # <-- find out what 3 chars these are!
$value =~ s/(\n)$//;
$value =~ s/(\r)$//;
if ($field_header =~ /name="(.*)";.filename="(.*)"/)
{
$name = $1;
$filename = $2;
$filename =~ s/\\/\//g;
# Get local filename without path
@xdirs = split("/",$filename);
$filename = pop(@xdirs);
$filename =~ s/[\s\n\r\t]//g; # get rid of white-space from filename
$FORM{$name} = $value;
$FORM{"$name.src"} = $filename;
if ($debug == 1)
{
print "Setting '$name' = '$value'<br>\n";
print "Setting '$name.src' = '$filename'<br>\n";
}
}
elsif ($field_header =~ /name="(.*)"/)
{
$name = $1; # Field name
if ($debug == 1)
{
print "Setting '$name' = '$value'<br>\n";
}
$FORM{$name} = $value;
}
else
{
# Error handling - unsupported format
print "Content-type: text/html\n\n";
print "Your browser does not appear to be able to handle multipart
forms.<P>\n";
print "$field\n";
exit;
}
}
@pairs = split(/&/, $ENV{'QUERY_STRING'});
foreach $pair(@pairs)
{
($name, $value)=split(/=/, $pair);
$value =~ tr/+/ /;
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
$URL{$name} = $value;
}
return;
}
#================================
# Sub: header
#================================
sub header
{
local($title) = @_;
if ($title eq "")
{
$title = "NetbloomsDirect";
}
if (($header_file ne "")&& (-e $header_file))
{
open (HEADER,"$header_file")|| die &error(92);
print "Content-type: text/html\n\n";
while ($line = <HEADER>)
{
print $line;
}
close (HEADER);
return;
}
print <<EOM;
Content-type: text/html
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">
<html>
<head>
<title>$title</title>
</head>
<body text="$textcolor" link="$linkcolor" vlink="$linkcolor"
bgcolor="$bgcolor" marginheight="0" marginwidth="0" topmargin="0"
leftmargin="0">
<table border="0" width="100%" cellpadding="3" cellspacing="0">
<tr>
<td width="95%" bgcolor="0000FF"><font size="-0" color="#ffffff"
face="Arial"> <strong>$title</strong></font></td>
<td bgcolor="0808FF"><font size="-2"> </font></td>
<td bgcolor="1010FF"><font size="-2"> </font></td>
<td bgcolor="1818FF"><font size="-2"> </font></td>
<td bgcolor="2020FF"><font size="-2"> </font></td>
<td bgcolor="2828FF"><font size="-2"> </font></td>
<td bgcolor="3030FF"><font size="-2"> </font></td>
<td bgcolor="3838FF"><font size="-2"> </font></td>
<td bgcolor="4040FF"><font size="-2"> </font></td>
<td bgcolor="4848FF"><font size="-2"> </font></td>
<td bgcolor="5050FF"><font size="-2"> </font></td>
<td bgcolor="5858FF"><font size="-2"> </font></td>
<td bgcolor="6060FF"><font size="-2"> </font></td>
<td bgcolor="6868FF"><font size="-2"> </font></td>
<td bgcolor="7070FF"><font size="-2"> </font></td>
<td bgcolor="7878FF"><font size="-2"> </font></td>
<td bgcolor="8080FF"><font size="-2"> </font></td>
<td bgcolor="8888FF"><font size="-2"> </font></td>
<td bgcolor="9090FF"><font size="-2"> </font></td>
<td bgcolor="9898FF"><font size="-2"> </font></td>
<td bgcolor="A0A0FF"><font size="-2"> </font></td>
<td bgcolor="A8A8FF"><font size="-2"> </font></td>
<td bgcolor="B0B0FF"><font size="-2"> </font></td>
<td bgcolor="B8B8FF"><font size="-2"> </font></td>
<td bgcolor="C0C0FF"><font size="-2"> </font></td>
<td bgcolor="C8C8FF"><font size="-2"> </font></td>
<td bgcolor="D0D0FF"><font size="-2"> </font></td>
<td bgcolor="D8D8FF"><font size="-2"> </font></td>
<td bgcolor="E0E0FF"><font size="-2"> </font></td>
<td bgcolor="E8E8FF"><font size="-2"> </font></td>
<td bgcolor="F0F0FF"><font size="-2"> </font></td>
<td bgcolor="F8F8FF"><font size="-2"> </font></td>
<td bgcolor="FBFBFF"><font size="-2"> </font></td>
</tr>
</table>
<br>
EOM
}
#================================
# Sub: footer
#================================
sub footer
{
if (($footer_file ne "")&& (-e $footer_file))
{
open (FOOTER,"$footer_file")|| die &error(93);
while ($line = <HEADER>)
{
print $line;
}
close (HEADER);
return;
}
print <<EOM;
<br>
<table border="0" cellpadding="1" cellspacing="0" width="100%">
<td width="100%" align="right">
<font face="Arial,Helvetica,Sans Serif" size="-2">
NetbloomsDirect v$REGISTRY[0] ©1997-2001 <a
href="http://www.netbloomsdirect.com";>NETBLOOMSDIRECT.COM</a>
</font>
</td>
</table>
</body>
</html>
EOM
}
#================================
# error
#================================
sub error
{
local($code,$marker) = @_;
&header("Error $code");
print "</table></table></ul></ol></blockquote></div>\n";
print "</table></table></ul></ol></blockquote></div>\n";
print "</table></table></ul></ol></blockquote></div>\n";
print "</table></table></ul></ol></blockquote></div>\n";
print "</table></table></ul></ol></blockquote></div>\n";
print "</table></table></ul></ol></blockquote></div>\n";
print <<EOM;
<div align="center"><center>
<table border="0" cellpadding="2" cellspacing="0" width="80%">
<td width="100%">
<font face="Arial,Helvetica,Sans-Serif" size="-1">
EOM
if ($code == 10) #Profile doesn't exist
{
print "<h1>NetbloomsDirect Configuration Error</h1><P>\n";
print "Please check that the profile: <tt>$home/$URL{'config'}</tt>
exists.\n";
print "<P>";
}
elsif ($code == 11) #Profile incorrect format
{
print "<h1>NetbloomsDirect Configuration Error</h1><P>\n";
print "Please check that the profile: <tt>$home/$Config</tt> is properly
formatted:<P>\n";
print "Your config file should have the following lines:<br>\n";
print "<ul>\n<li>username\n<li>password<li>path and filename<li>image
path<br> (see documentation)</ul>\n";
print "<P>";
}
elsif ($code == 12) # License error
{
print "<h1>NetbloomsDirect License Error</h1><P>\n";
print "Your license code appears to be incorrect. Please check the
license that you were provided.<P>\n";
print "<P>";
}
elsif ($code == 13) #Domain error - not licensed
{
print "<h1>NetbloomsDirect Domain License Error</h1><P>\n";
print "This copy of NetbloomsDirect is not licensed for use with this
domain. Please check the license that you were provided.<P>\n";
print "<P>";
}
elsif ($code == 20) #Bad username/password
{
print "<h1>Bad username/password Combination</h1><P>\n";
print "<P>";
}
elsif ($code == 30) #Incomplete Form
{
print "<h1>Form incomplete</h1><P>\n";
print "Please complete the <font color=000000>Value</font> fields";
print " for all the checked NetbloomsDirect Web Page Markers.<P>\n";
print "<P>";
}
elsif ($code == 40) #Page in config file doesn't exist
{
print "<h1>Specified file $CONFIG{'PAGE'} does not exist or does not
have read permissions</h1><P>\n";
print "Check to see that the path and filename is correct in your
profile and that file permissions
are set correctly.\n";
print "<P>";
}
elsif ($code == 50) #Page doesn't have write permissions
{
print "<h1>Specified file $CONFIG{'PAGE'} does not have write
permissions</h1><P>\n";
print "Check with your system administrator. \n";
print "<P>";
}
elsif ($code == 51) #Backup Page doesn't have write permissions
{
print "<h1>Specified file $bakfile does not have write
permissions</h1><P>\n";
print "Check with your system administrator. \n";
print "<P>";
}
elsif ($code == 55) #Uploading permissions
{
print "<h1>File(s) cannot be uploaded because the directories
($imgpath/$imagepath) or ($imgpath/$filepath) do not have write
permissions</h1><P>\n";
print "Check with your system administrator. \n";
print "<P>";
}
elsif ($code == 56) #Uploading permissions
{
print "<h1>File(s) cannot be uploaded because the directories
($imgpath/$imagepath) or ($imgpath/$filepath) do not have rename or delete
permissions</h1><P>\n";
print "Check with your system administrator. \n";
print "<P>";
}
elsif ($code == 60) #Page doesn't have marker tags
{
print "<h1>Specified file $page does not contain proper marker
tags.</h1><P>\n";
print "Your HTML file should contain two comment tags around each
section you want to update. ";
print "The marker you specified in your config is <font
color=000000>$marker</font>, so your tags ";
print "should be:<P>";
print "<font color=000000><tt>";
print "<!--FP:$marker--><br>";
print " (This area will be replaced) <br>";
print "<!--FP:$marker--><br></font></tt><br>";
print "Check your documentation to ensure that you have proper comment
tags defined. \n";
print "<P>";
}
elsif ($code == 70) #Reached end of file without markers...
{
print "<h1>Page not formatted properly</h1><P>\n";
print "Check your marker tags to ensure that they are correct.
NetbloomsDirect could not find a valid pair of marker tags ";
print "for \"<b>$marker</b>\".\n";
print "<P>";
}
elsif ($code == 71) #Reached end of file without markers...
{
print "<h1>Specified NetbloomsDirect tag not found.</h1><P>\n";
print "The editor read a field that now no longer exists in the page.
Has the page changed since you started making changes?";
print "for \"<b>$marker</b>\".\n";
print "<P>";
}
elsif ($code == 90) #Invalid Mode specified
{
print "<h1>Invalid Mode Specified</h1><P>\n";
print "The mode specified in your form is not valid.";
print "<P>";
}
elsif ($code == 92) #Cannot open header file
{
print "<h1>Cannot open Header File</h1><P>\n";
print "Please check that the header file exists and has read access.";
print "<P>";
}
elsif ($code == 93) #Cannot open footer file
{
print "<h1>Cannot open Footer File</h1><P>\n";
print "Please check that the footer file exists and has read access.";
print "<P>";
}
else #Other error
{
print "<h1>An unknown error occurred.</h1><P>\n";
print "Please contact your system administrator.\n";
print "<P>";
}
print <<EOM;
The above problem must be corrected before you will be able to update your
page.
Please check that you username and password are correct, and that all of the
configuration
options are set properly. If you are unable to determine the problem, check
the online
resources at the NetbloomsDirect website at <a
href="http://www.iexp.com/products/fastpage/";>http://www.iexp.com/products/fastpage/</a>.
<br>
<br>
Please click your browser's <em>Back</em> button to go back to the previous
page.
</font>
</td>
</table>
</center></div>
EOM
&footer;
exit;
}
_________________________________________________________________
Get your FREE download of MSN Explorer at http://explorer.msn.com