Adding coposys
svn path=/trunk/; revision=3131
This commit is contained in:
parent
69cbfc27d1
commit
f0e18d5bfb
446
cgi-bin/coposys
Normal file
446
cgi-bin/coposys
Normal file
@ -0,0 +1,446 @@
|
||||
#!/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.3 2003-02-01 15:23:34 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='/var/www/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.3 $ </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";
|
||||
}
|
||||
Loading…
x
Reference in New Issue
Block a user