447 lines
11 KiB
Perl
447 lines
11 KiB
Perl
#!/usr/bin/perl -w
|
|
|
|
# Copyright (C) 2001 Cyril Bouthors
|
|
#
|
|
# This program is free software; you can redistribute it and/or modify
|
|
# it under the terms of the GNU General Public License as published by
|
|
# the Free Software Foundation; either version 2 of the License, or
|
|
# (at your option) any later version.
|
|
#
|
|
# This program is distributed in the hope that it will be useful, but
|
|
# WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
|
# General Public License for more details.
|
|
#
|
|
# You should have received a copy of the GNU General Public License
|
|
# along with this program; if not, write to the Free Software
|
|
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
|
|
# 02111-1307, USA.
|
|
#
|
|
# $Id: coposys,v 1.4 2003-02-01 15:24:12 jonas Exp $
|
|
#
|
|
|
|
use integer;
|
|
use diagnostics;
|
|
use sigtrap qw(SEGV BUS);
|
|
use strict qw(subs vars refs);
|
|
use subs qw(afunc blurfl);
|
|
|
|
use CGI qw/:standard/;
|
|
|
|
# people in the database
|
|
my %people;
|
|
|
|
# directory containing the marker files for xplanet
|
|
# named thecommunity.mark
|
|
my $markerdir='/home/www/var/coposys';
|
|
|
|
# markerfile
|
|
# format :
|
|
# latitude longitude "name" #password, date, email
|
|
my $filename;
|
|
|
|
#
|
|
# Syntax of CGI calls :
|
|
#
|
|
# coposys?community='thecommunity' : displays main form
|
|
# coposys?add&name=&password=&password2=&latitude=&longitude=&email=&community=
|
|
# coposys?update&name=&password=&latitude=&longitude=&email=&community=
|
|
# coposys?delete&name=&del_password=&community=
|
|
#
|
|
|
|
print header;
|
|
|
|
if (param('community')) {
|
|
|
|
$filename = $markerdir . '/' . param('community') . '.mark';
|
|
|
|
print '<b>Coposys $Revision: 1.4 $ </b>' , "\n\n",
|
|
"Manage members of a community </b>\n\n";
|
|
|
|
# form for adding a new member of the community
|
|
display_add_update_forms();
|
|
|
|
# display a refresh button
|
|
display_list_form();
|
|
|
|
treat_args();
|
|
|
|
# displays a list of members of the community, with a password field next to each to allow modifications
|
|
display_community();
|
|
|
|
}
|
|
else {
|
|
print start_html('error'), 'You need the community argument';
|
|
}
|
|
|
|
print end_html;
|
|
|
|
################################################################
|
|
|
|
sub display_add_update_forms {
|
|
my $date = localtime();
|
|
|
|
print start_html('Coposys.');
|
|
|
|
# Add part of the form
|
|
print "<table border=\"1\">\n";
|
|
print " <tr><td>",
|
|
|
|
"<b>Use this form to register in the community <i>".
|
|
param('community'). "</i></b> \n",
|
|
|
|
start_form,
|
|
|
|
" Full Name ", textfield('name'), "\n ", p,
|
|
|
|
"Password ",
|
|
password_field({name=>'password',size=>'8',maxlength=>8}), "\n ", p,
|
|
|
|
"Password (again) ",
|
|
password_field({name=>'password2',size=>8,maxlength=>8}), "\n ", p,
|
|
|
|
"Latitude ", textfield('latitude'), "\n ", p,
|
|
|
|
"Longitude ", textfield('longitude'), "\n ", p,
|
|
|
|
hidden({name=>'community'}), "\n ",
|
|
|
|
hidden({name=>'date',default=>$date}), "\n",
|
|
|
|
" Email ", textfield('email'), "\n ", p,
|
|
|
|
submit({name=>'add'}), "\n",
|
|
end_form, "\n\n";
|
|
|
|
print "</td>";
|
|
|
|
|
|
# Update part of the form
|
|
print "<td>",
|
|
|
|
"<b>Use this form to update your registration in the community <i>".
|
|
param('community'), "</i></b> \n",
|
|
|
|
start_form,
|
|
|
|
" Full Name ", textfield('name'), "\n ", p,
|
|
|
|
"Password ",
|
|
password_field({name=>'password',size=>'8',maxlength=>8}), "\n ", p,
|
|
|
|
"Latitude ", textfield('latitude'), "\n ", p,
|
|
|
|
"Longitude ", textfield('longitude'), "\n ", p,
|
|
|
|
hidden({name=>'community'}), "\n ",
|
|
|
|
hidden({name=>'date',default=>$date}), "\n",
|
|
|
|
" Email ", textfield('email'), "\n ", p,
|
|
|
|
submit({name=>'update'}), "\n",
|
|
|
|
"</td></tr>\n",
|
|
|
|
"</table>\n";
|
|
|
|
}
|
|
|
|
# displays an HTML form containing the refresh button
|
|
sub display_list_form {
|
|
print start_form, "\n ",
|
|
hidden({name=>'community'}), "\n ",
|
|
# displays a refresh button
|
|
submit({name=>'refresh'}), "\n",
|
|
end_form, "\n";
|
|
}
|
|
|
|
# execute actions depending on the form called
|
|
sub treat_args {
|
|
if ( param('add') ) {
|
|
if (
|
|
param('name') &&
|
|
param('password') &&
|
|
param('password2') &&
|
|
param('latitude') &&
|
|
param('longitude') &&
|
|
param('email') &&
|
|
param('community')
|
|
)
|
|
{
|
|
add_name();
|
|
}
|
|
else {
|
|
html_error('Missing argument !');
|
|
}
|
|
}
|
|
elsif ( param('update') ) {
|
|
if (
|
|
param('name') &&
|
|
param('password') &&
|
|
param('latitude') &&
|
|
param('longitude') &&
|
|
param('email') &&
|
|
param('community')
|
|
)
|
|
{
|
|
update_name();
|
|
}
|
|
else {
|
|
html_error('Missing argument or password entered twice for update !');
|
|
}
|
|
}
|
|
elsif ( param('delete') ) {
|
|
delete_name();
|
|
}
|
|
}
|
|
|
|
sub update_name {
|
|
my ($latitude, $longitude, $name, $password, $date, $email);
|
|
|
|
load_data();
|
|
|
|
# check if the name already exists..
|
|
if (!defined $people{param('name')} ) {
|
|
html_error(param('name') . ' I don\'t know you. ' .
|
|
'Please register first.');
|
|
}
|
|
|
|
# Check if password is correct...
|
|
my $crypted_passwd = (split /,/ , $people{param('name')})[3];
|
|
|
|
# get the salt from crypted_passwd
|
|
my $salt = $crypted_passwd;
|
|
$salt =~ s/^(..).*/$1/;
|
|
|
|
# and check for good pass...
|
|
if (crypt (param('password'), $salt) ne $crypted_passwd) {
|
|
html_error('Incorrect password !');
|
|
return;
|
|
}
|
|
|
|
# check if latitude is valid
|
|
unless ( param('latitude') =~ /^[\d\+\-\.]+$/ ) {
|
|
html_error('Invalid latitude: The format is +-DDD.DDDDDDDDDDDDDDD. ' .
|
|
'This is the format programs like xearth use and the ' .
|
|
'format that many positioning web sites use. However ' .
|
|
'typically the precision is limited to 4 or 5 decimals.');
|
|
return;
|
|
}
|
|
|
|
# check if longitude is valid
|
|
unless ( param('longitude') =~ /^[\d\+\-\.]+$/ ) {
|
|
html_error('Invalid longitude: The format is +-DDD.DDDDDDDDDDDDDDD. ' .
|
|
'This is the format programs like xearth use and the ' .
|
|
'format that many positioning web sites use. However ' .
|
|
'typically the precision is limited to 4 or 5 decimals.');
|
|
return;
|
|
}
|
|
|
|
# Now, write marker file with modifications
|
|
unless (open (CFG, ">$filename")) {
|
|
html_error("Unable to open marker file ($filename) !");
|
|
print end_html;
|
|
die;
|
|
}
|
|
|
|
foreach my $name (keys %people) {
|
|
|
|
if ($name eq param('name')) {
|
|
# the new value... No check is made, but it's not a good idea...
|
|
print CFG param('latitude') . ' ' .
|
|
param('longitude') .' "' . $name . '" #' .
|
|
$crypted_passwd . ',' . localtime() . ',' . param('email') . "\n";
|
|
next;
|
|
}
|
|
|
|
($latitude, $longitude, $crypted_passwd, $date, $email) =
|
|
(split /,/ , $people{$name})[0,1,3,4,5];
|
|
|
|
print CFG $latitude . ' '
|
|
. $longitude . ' "'
|
|
. $name . '" #' .
|
|
$crypted_passwd . ',' .
|
|
$date . ',' .
|
|
$email . "\n";
|
|
|
|
}
|
|
close CFG;
|
|
|
|
}
|
|
|
|
sub add_name {
|
|
|
|
load_data();
|
|
|
|
# check if we don't already have it
|
|
if ( defined $people{param('name')} ) {
|
|
html_error(param('name') . ' already exists !');
|
|
return;
|
|
}
|
|
|
|
# check if passwords match
|
|
if (param('password') ne param('password2')) {
|
|
html_error('Password mismatch !');
|
|
return;
|
|
}
|
|
|
|
# check if password is valid
|
|
unless ( param('password') =~ /^[\w\d]+$/ ) {
|
|
html_error('Invalid password: it should only contain alphanumerics !');
|
|
return;
|
|
}
|
|
|
|
# crypt password
|
|
my $randletter = "(int (rand (26)) + (int (rand (1) + .5) % 2 ? 65 : 97))";
|
|
my $salt = sprintf ("%c%c", eval $randletter, eval $randletter);
|
|
|
|
my $crypted_passwd = crypt (param('password'), $salt);
|
|
|
|
my $name=param('name');
|
|
$name=~s/"//g; #"
|
|
|
|
# check if latitude is valid
|
|
unless ( param('latitude') =~ /^[\d\+\-\.]+$/ ) {
|
|
html_error('Invalid latitude: The format is +-DDD.DDDDDDDDDDDDDDD. ' .
|
|
'This is the format programs like xearth use and the ' .
|
|
'format that many positioning web sites use. However ' .
|
|
'typically the precision is limited to 4 or 5 decimals.');
|
|
return;
|
|
}
|
|
|
|
# check if longitude is valid
|
|
unless ( param('longitude') =~ /^[\d\+\-\.]+$/ ) {
|
|
html_error('Invalid longitude: The format is +-DDD.DDDDDDDDDDDDDDD. ' .
|
|
'This is the format programs like xearth use and the ' .
|
|
'format that many positioning web sites use. However ' .
|
|
'typically the precision is limited to 4 or 5 decimals.');
|
|
return;
|
|
}
|
|
|
|
unless (open (CFG, ">>$filename")) {
|
|
html_error("Unable to open marker file ($filename) !");
|
|
print end_html;
|
|
die;
|
|
}
|
|
|
|
print CFG param('latitude') . ' ' . param('longitude') .
|
|
' "' . $name . '" #' .
|
|
$crypted_passwd .
|
|
',' . param('date') .
|
|
',' . param('email') . "\n";
|
|
close CFG;
|
|
}
|
|
|
|
sub display_community {
|
|
my ($latitude, $longitude, $name, $password, $date, $email);
|
|
|
|
load_data();
|
|
|
|
Delete('name');
|
|
|
|
print "<b>Members of the community <i>". param('community'). "</i> :</b> \n";
|
|
|
|
print "<table border=\"1\">\n";
|
|
print " <tr><td>Name</td><td>Latitude</td><td>Longitude</td>" ;
|
|
print "<td>Last update</td><td>Email</td></tr>\n";
|
|
|
|
foreach my $key (sort keys %people) {
|
|
($latitude, $longitude, $name, $password, $date, $email) =
|
|
split /,/ , $people{$key};
|
|
$email =~ s/\@/ AT /g;
|
|
$email =~ s/\./ DOT /g;
|
|
|
|
|
|
print " <tr>\n";
|
|
print " <td>$key</td>\n";
|
|
print " <td>$latitude</td>\n";
|
|
print " <td>$longitude</td>\n";
|
|
print " <td>$date</td>\n";
|
|
print " <td>$email</td>\n";
|
|
|
|
# print the piece of form allowing deletion of the name
|
|
print " <td>\n " . start_form, " ",
|
|
"password: ",
|
|
password_field({name=>'del_password',size=>8,maxlength=>8}), "\n ",
|
|
hidden({name=>'community'}), "\n ",
|
|
hidden({name=>'name', default=>$key}), "\n ",
|
|
submit({name=>'delete'}), "\n ",
|
|
end_form, "\n </td>\n";
|
|
|
|
print " </tr>\n";
|
|
}
|
|
print "</table>\n";
|
|
|
|
}
|
|
|
|
sub load_data {
|
|
my ($latitude, $longitude, $name, $password, $date, $email);
|
|
|
|
unless (open (CFG, $filename)) {
|
|
html_error("Unable to open marker file ($filename)!");
|
|
print end_html;
|
|
die;
|
|
}
|
|
|
|
while (<CFG>) {
|
|
s/^(.*) (.*) "(.*)" #(.*),(.*),(.*)$//;
|
|
($latitude, $longitude, $name, $password, $date, $email)
|
|
=($1,$2,$3,$4,$5,$6);
|
|
$people{$name}="$latitude,$longitude,$name,$password,$date,$email";
|
|
}
|
|
|
|
close CFG;
|
|
|
|
}
|
|
|
|
sub delete_name {
|
|
my ($latitude, $longitude, $name, $crypted_passwd, $date, $email);
|
|
|
|
load_data();
|
|
|
|
# check if password match
|
|
($crypted_passwd) = (split /,/ , $people{param('name')})[3];
|
|
|
|
# get the salt from crypted_passwd
|
|
my $salt = $crypted_passwd;
|
|
$salt =~ s/^(..).*/$1/;
|
|
|
|
if (crypt (param('del_password'), $salt) ne $crypted_passwd) {
|
|
html_error('Password mismatch when trying to delete !');
|
|
return;
|
|
}
|
|
|
|
unless (open (CFG, ">$filename")) {
|
|
html_error("Unable to open marker file ($filename) !");
|
|
print end_html;
|
|
die;
|
|
}
|
|
|
|
foreach my $name (keys %people) {
|
|
|
|
if ($name eq param('name')) {
|
|
delete $people{$name};
|
|
next;
|
|
}
|
|
|
|
($latitude, $longitude, $crypted_passwd, $date, $email) =
|
|
(split /,/ , $people{$name})[0,1,3,4,5];
|
|
|
|
print CFG $latitude . ' '
|
|
. $longitude . ' "'
|
|
. $name . '" #' .
|
|
$crypted_passwd . ',' .
|
|
$date . ',' .
|
|
$email . "\n";
|
|
|
|
}
|
|
close CFG;
|
|
}
|
|
|
|
sub html_error {
|
|
my $message = shift;
|
|
|
|
print '<p><font color="#FF0000">' . $message . "</font>\n";
|
|
}
|