From 8bb9e9bbb6dd51b045a7abc44e097ea1c30e0c07 Mon Sep 17 00:00:00 2001 From: Michal Vaner Date: Fri, 4 Jul 2008 15:04:32 +0200 Subject: [PATCH] Import everything --- internet/database.en.txt | 83 ++++ internet/impl/PciIds/Address.pm | 21 + internet/impl/PciIds/Address/Base.pm | 38 ++ internet/impl/PciIds/Address/Pci.pm | 55 +++ internet/impl/PciIds/Address/PciClass.pm | 47 ++ internet/impl/PciIds/Address/Toplevel.pm | 72 ++++ internet/impl/PciIds/Config.pm | 47 ++ internet/impl/PciIds/DBQ.pm | 316 ++++++++++++++ internet/impl/PciIds/DBQAny.pm | 53 +++ internet/impl/PciIds/Db.pm | 19 + internet/impl/PciIds/Email.pm | 26 ++ internet/impl/PciIds/Html/Admin.pm | 170 ++++++++ internet/impl/PciIds/Html/Changes.pm | 137 ++++++ internet/impl/PciIds/Html/Debug.pm | 21 + internet/impl/PciIds/Html/Format.pm | 36 ++ internet/impl/PciIds/Html/Forms.pm | 68 +++ internet/impl/PciIds/Html/Handler.pm | 74 ++++ internet/impl/PciIds/Html/HandlerPlain.pm | 10 + internet/impl/PciIds/Html/HandlerSSL.pm | 10 + internet/impl/PciIds/Html/List.pm | 77 ++++ internet/impl/PciIds/Html/Notifications.pm | 87 ++++ internet/impl/PciIds/Html/Tables.pm | 26 ++ internet/impl/PciIds/Html/Users.pm | 471 +++++++++++++++++++++ internet/impl/PciIds/Html/Util.pm | 120 ++++++ internet/impl/PciIds/Log.pm | 36 ++ internet/impl/PciIds/Notifications.pm | 82 ++++ internet/impl/PciIds/Users.pm | 129 ++++++ internet/impl/PciIds/Xmpp.pm | 34 ++ internet/impl/Startup.pm | 13 + internet/impl/config | 11 + internet/impl/notes | 10 + internet/impl/rights | 2 + internet/impl/scripts/cleardb.pl | 15 + internet/impl/scripts/export.pl | 32 ++ internet/impl/scripts/feeddb.pl | 63 +++ internet/impl/scripts/importlog.pl | 86 ++++ internet/impl/scripts/init | 6 + internet/impl/scripts/initdb.pl | 47 ++ internet/impl/scripts/mailbot | 296 +++++++++++++ internet/impl/scripts/rights.pl | 61 +++ internet/impl/scripts/send_notifs.pl | 18 + internet/impl/scripts/transfer.pl | 77 ++++ internet/impl/static/print.css | 27 ++ internet/impl/static/screen.css | 45 ++ internet/impl/tables | 88 ++++ internet/specifikace.txt | 19 + 46 files changed, 3281 insertions(+) create mode 100644 internet/database.en.txt create mode 100644 internet/impl/PciIds/Address.pm create mode 100644 internet/impl/PciIds/Address/Base.pm create mode 100644 internet/impl/PciIds/Address/Pci.pm create mode 100644 internet/impl/PciIds/Address/PciClass.pm create mode 100644 internet/impl/PciIds/Address/Toplevel.pm create mode 100644 internet/impl/PciIds/Config.pm create mode 100644 internet/impl/PciIds/DBQ.pm create mode 100644 internet/impl/PciIds/DBQAny.pm create mode 100644 internet/impl/PciIds/Db.pm create mode 100644 internet/impl/PciIds/Email.pm create mode 100644 internet/impl/PciIds/Html/Admin.pm create mode 100644 internet/impl/PciIds/Html/Changes.pm create mode 100644 internet/impl/PciIds/Html/Debug.pm create mode 100644 internet/impl/PciIds/Html/Format.pm create mode 100644 internet/impl/PciIds/Html/Forms.pm create mode 100644 internet/impl/PciIds/Html/Handler.pm create mode 100644 internet/impl/PciIds/Html/HandlerPlain.pm create mode 100644 internet/impl/PciIds/Html/HandlerSSL.pm create mode 100644 internet/impl/PciIds/Html/List.pm create mode 100644 internet/impl/PciIds/Html/Notifications.pm create mode 100644 internet/impl/PciIds/Html/Tables.pm create mode 100644 internet/impl/PciIds/Html/Users.pm create mode 100644 internet/impl/PciIds/Html/Util.pm create mode 100644 internet/impl/PciIds/Log.pm create mode 100644 internet/impl/PciIds/Notifications.pm create mode 100644 internet/impl/PciIds/Users.pm create mode 100644 internet/impl/PciIds/Xmpp.pm create mode 100644 internet/impl/Startup.pm create mode 100644 internet/impl/config create mode 100644 internet/impl/notes create mode 100644 internet/impl/rights create mode 100755 internet/impl/scripts/cleardb.pl create mode 100755 internet/impl/scripts/export.pl create mode 100755 internet/impl/scripts/feeddb.pl create mode 100755 internet/impl/scripts/importlog.pl create mode 100755 internet/impl/scripts/init create mode 100755 internet/impl/scripts/initdb.pl create mode 100755 internet/impl/scripts/mailbot create mode 100755 internet/impl/scripts/rights.pl create mode 100755 internet/impl/scripts/send_notifs.pl create mode 100755 internet/impl/scripts/transfer.pl create mode 100644 internet/impl/static/print.css create mode 100644 internet/impl/static/screen.css create mode 100644 internet/impl/tables create mode 100644 internet/specifikace.txt diff --git a/internet/database.en.txt b/internet/database.en.txt new file mode 100644 index 0000000..8bf7dd4 --- /dev/null +++ b/internet/database.en.txt @@ -0,0 +1,83 @@ +The database consists of these tables: + +Table of users +============== +Each line represents one user, be it the usual one without any +access rights or a privileged one. There there is information about +every user: +• Internal ID +• Email address +• XMPP address +• Login name +• Password hash +• Info about last login (for safety - show it on login) [can be empty] +• Time the system should gather email notifications before sending a +message +• Time the system should gather XMPP notifications before sending a +message +• Time of the next email message [can be empty when nothing pending] +• Time of the next XMPP message [can be empty when nothing pending] + +Access rights table +=================== +Contains all access rights above the normal. It does not need any data +with the normal users (which will be the most of them) and it is +possible to add new rights without restructuring the database. +Every line will contain: +• Internal users ID +• ID of the right (what this line allows to the user) +• Location (for rights applied locally) [can be empty, if it makes +no sense with the right] + +Table of locations +================== +The locations are saved in a tree. ID of the location is created by +appending the local IDs of the nodes on the path together (children of +the root first), separated by '/'. Each node must know, how long are +the local IDs of its children. + +(Note that the local IDs can contain '/', since it can be recognized +by its length.) + +The first part is 2-letter specifier of information type. The first +version has these: +PC: PCI ID +PD: PCI Device Class + +If there is some location ending by additional '/', it means the whole +subtree. If not, then it means the node only. + +For every node, this information is stored: +• ID of the location (must be node only - without the additional '/') +• ID of referenced location (for symlinks) [can be empty] +• ID of the main article (see below) [can be empty] +• Name [Can be empty, should match the main article] +• Comment [Can be empty, should match the main article] + +Table of history +================ +Contains articles in the discussion. + +• ID of the article +• ID of location, where it belongs +• Text +• Modification of the node name [can be empty, in that case can not be +the main article] +• Modification of the node comment [can be empty] + +Table of notifications +====================== +These are hooks for notifications. +• ID of the user +• ID of the location to which the notification should be sent. +• Notification type (New article, name or comment change, change of +the main article - everything contains all less common). +• Way of notification (Email, XMPP, Both) + +Table of pending notifications +============================== +This is where all yet unsent notifications wait. They consist of these +fields: +• ID of the user +• ID of the article +• Way of notification (if both, it gets split into two notifications) diff --git a/internet/impl/PciIds/Address.pm b/internet/impl/PciIds/Address.pm new file mode 100644 index 0000000..73a9282 --- /dev/null +++ b/internet/impl/PciIds/Address.pm @@ -0,0 +1,21 @@ +package PciIds::Address; +use strict; +use warnings; +use PciIds::Address::Pci; +use PciIds::Address::PciClass; + +sub new( $ ) { + my( $address ) = @_; + $address =~ s/\/(mods|read|static)//;#Eat the prefix + $address =~ s/\/$//; + $address =~ s/^\///; + if( $address =~ /^PC/ ) { + return PciIds::Address::Pci::new( $address ); + } elsif( $address =~ /^PD/ ) { + return PciIds::Address::PciClass::new( $address ); + } else { + return undef; + } +} + +1; diff --git a/internet/impl/PciIds/Address/Base.pm b/internet/impl/PciIds/Address/Base.pm new file mode 100644 index 0000000..5f78ec9 --- /dev/null +++ b/internet/impl/PciIds/Address/Base.pm @@ -0,0 +1,38 @@ +package PciIds::Address::Base; +use strict; +use warnings; +use PciIds::Address; + +sub new( $ ) { + return bless { + 'value' => shift + } +} + +sub get( $ ) { + return shift->{'value'}; +} + +sub parent( $ ) { + my( $new ) = ( shift->get() ); + $new =~ s/[^\/]+\/?$//; + return PciIds::Address::new( $new ); +} + +sub tail( $ ) { + my( $new ) = ( shift->get() ); + $new =~ s/.*\/(.)/$1/; + return $new; +} + +sub canAddComment( $ ) { + return 1; #By default, comments can be added anywhere +} + +sub canAddItem( $ ) { return !shift->leaf(); } + +sub defaultRestrict( $ ) { return "" }; + +sub defaultRestrictList( $ ) { return [] }; + +1; diff --git a/internet/impl/PciIds/Address/Pci.pm b/internet/impl/PciIds/Address/Pci.pm new file mode 100644 index 0000000..61bead4 --- /dev/null +++ b/internet/impl/PciIds/Address/Pci.pm @@ -0,0 +1,55 @@ +package PciIds::Address::Pci; +use strict; +use warnings; +use PciIds::Address::Toplevel; +use base 'PciIds::Address::Base'; + +sub new( $ ) { + my( $address ) = @_; + return PciIds::Address::Toplevel::new( $address ) if( $address =~ /^PC\/?$/ ); + return bless PciIds::Address::Base::new( $address ); +} + +sub pretty( $ ) { + my $self = shift; + $_ = $self->get(); + s/^PC\/?//; + s/\//:/g; + s/([0-9a-f]{4,4})([0-9a-f]{4,4})/$1 $2/g; + my $prefix = ''; + if( /:.*:/ ) { + $prefix = 'Subsystem'; + } elsif( /:/ ) { + $prefix = 'Device'; + } else { + $prefix = 'Vendor'; + } + return $prefix.' '. $_; +} + +sub tail( $ ) { + my( $new ) = ( shift->get() ); + $new =~ s/.*\/(.)/$1/; + $new =~ s/([0-9a-f]{4,4})([0-9a-f]{4,4})/$1 $2/g; + return $new; +} + +sub restrictRex( $$ ) { + my( $self, $restrict ) = @_; + my( $result ) = ( $restrict =~ /^([a-f0-9]{1,4})/ );#TODO every time? + return $result; +} + +sub leaf( $ ) { + return ( shift->get() =~ /\/.*\/.*\// ); +} + +sub append( $$ ) { + my( $self, $suffix ) = @_; + return ( undef, 'You can not add to leaf node' ) if( $self->leaf() ); + $suffix =~ s/ //g; + return ( undef, "Invalid ID syntax" ) unless ( ( ( $self->get() !~ /^PC\/.*\// ) && ( $suffix =~ /^[0-9a-f]{4}$/ ) ) || ( ( $self->get() =~ /^PC\/.*\// ) && ( $suffix =~ /^[0-9a-f]{8}$/ ) ) ); + return ( PciIds::Address::Base::new( $self->{'value'} . ( ( $self->{'value'} =~ /\/$/ ) ? '' : '/' ) . $suffix ), undef ); +} + +1; diff --git a/internet/impl/PciIds/Address/PciClass.pm b/internet/impl/PciIds/Address/PciClass.pm new file mode 100644 index 0000000..993efc2 --- /dev/null +++ b/internet/impl/PciIds/Address/PciClass.pm @@ -0,0 +1,47 @@ +package PciIds::Address::PciClass; +use strict; +use warnings; +use PciIds::Address::Toplevel; +use base 'PciIds::Address::Base'; + +sub new( $ ) { + my( $address ) = @_; + return PciIds::Address::Toplevel::new( $address ) if( $address =~ /^PD\/?$/ ); + return bless PciIds::Address::Base::new( $address ); +} + +sub pretty( $ ) { + my $self = shift; + $_ = $self->get(); + s/^PD\/?//; + s/\//:/g; + my $prefix; + if( /:.*:/ ) { + $prefix = 'Program interface'; + } elsif( /:/ ) { + $prefix = 'Device subclass'; + } else { + $prefix = 'Device class'; + } + #TODO Other levels? Are the names OK? + return $prefix.' '.$_; +} + +sub restrictRex( $$ ) { + my( $self, $restrict ) = @_; + my( $result ) = ( $restrict =~ /^([a-f0-9]{1,4})/ );#TODO every time? + return $result; +} + +sub leaf( $ ) { + #TODO +} + +sub append( $$ ) { + my( $self, $suffix ) = @_; + return ( undef, 'You can not add to leaf node' ) if( $self->leaf() ); + return ( undef, "Invalid ID syntax" ) unless ( $suffix =~ /^[0-9a-f]{2,2}$/ ); + return ( PciIds::Address::Base::new( $self->{'value'} . ( ( $self->{'value'} =~ /\/$/ ) ? '' : '/' ) . $suffix ), undef ); +} + +1; diff --git a/internet/impl/PciIds/Address/Toplevel.pm b/internet/impl/PciIds/Address/Toplevel.pm new file mode 100644 index 0000000..26e78bb --- /dev/null +++ b/internet/impl/PciIds/Address/Toplevel.pm @@ -0,0 +1,72 @@ +package PciIds::Address::Toplevel; +use strict; +use warnings; +use base 'PciIds::Address::Base'; + +sub new( $ ) { + my( $value ) = @_; + if( $value =~ /^P[CD]\/?/ ) { + return bless PciIds::Address::Base::new( $value ); + } else { + return undef; + } +} + +sub pretty( $ ) { + my $self = shift; + if( $self->{'value'} =~ /^PC/ ) { + return 'PCI Devices'; + } else { + return 'PCI Device Classes'; + } +} + +sub restrictRex( $$ ) { + my( $self, $restrict ) = @_; + return PciIds::Address::new( $self->get().'/0000' )->restrictRex( $restrict );#Nasty trick, get the right address of any subnode and try it there +} + +sub leaf( $ ) { + return 0; +} + +sub append( $$ ) { + my( $self, $suffix ) = @_; + $suffix = lc $suffix; + if( $self->{'value'} =~ /^PC/ ) {#PCI + return ( undef, "Invalid ID syntax" ) unless ( $suffix =~ /^[0-9a-f]{4,4}$/ ); + } else {#PCI Device Class + return ( undef, "Invalid ID syntax" ) unless ( $suffix =~ /^[0-9a-f]{2,2}$/ ); + } + return ( PciIds::Address::Base::new( $self->{'value'} . ( ( $self->{'value'} =~ /\/$/ ) ? '' : '/' ) . $suffix ), undef ); +} + +sub canAddComment( $ ) { return 0; } + +sub defaultRestrict( $ ) { + my( $self ) = @_; + if( $self->get() =~ /PC/ ) { + return "0"; + } else { + return ""; + } +} + +sub defaultRestrictList( $ ) { + my( $self ) = @_; + if( $self->get() =~ /PC/ ) { + my @result; + for(my $i = '0'; $i < '10'; ++ $i ) { + push @result, $i; + } + push @result, ( 'a', 'b', 'c', 'd', 'e', 'f' ); + my @final; + push @final, [ $_, $_ ] foreach( @result ); + push @final, [ "", "all" ]; + return \@final; + } else { + return []; + } +} + +1; diff --git a/internet/impl/PciIds/Config.pm b/internet/impl/PciIds/Config.pm new file mode 100644 index 0000000..a179689 --- /dev/null +++ b/internet/impl/PciIds/Config.pm @@ -0,0 +1,47 @@ +package PciIds::Config; +use strict; +use warnings; +use Startup; +use base 'Exporter'; + +our @EXPORT = qw(&checkConf &defConf %config &confList); + +our %config; + +sub loadConf() { + open CONFIG, $directory."/config" or die "Config file not found. Make sure config is in the directory and the correct path is in Startup.pm\n"; + foreach( ) { + next if( /^\s*(|#.*)$/ ); + chomp; + my( $name, $val ); + die "Invalid syntax on line $_\n" unless( ( $name, $val ) = /^\s*(.*\S)\s*=\s*(.*\S)\s*$/ ); + $val =~ s/^"(.*)"$/$1/; + $config{$name} = $val; + } + close CONFIG; +} + +sub checkConf( $ ) { + my( $names ) = @_; + foreach( @{$names} ) { + die "Variable not set: $_\n" unless( defined $config{$_} ); + } +} + +sub defConf( $ ) { + my( $underlay ) = @_; + foreach( keys %{$underlay} ) { + $config{$_} = $underlay->{$_} unless( defined $config{$_} ); + } +} + +sub confList( $ ) { + my( $names ) = @_; + my( @result ); + push @result, $config{$_} foreach( @{$names} ); + return( @result ); +} + +loadConf(); + +return 1; diff --git a/internet/impl/PciIds/DBQ.pm b/internet/impl/PciIds/DBQ.pm new file mode 100644 index 0000000..02ca5c1 --- /dev/null +++ b/internet/impl/PciIds/DBQ.pm @@ -0,0 +1,316 @@ +package PciIds::DBQ; +use strict; +use warnings; +use base 'PciIds::DBQAny'; + +sub new( $ ) { + my( $dbh ) = @_; + my $node = 'SELECT id, name, description, maincomment FROM locations WHERE parent = ? ORDER BY '; + my $noder = 'SELECT id, name, description, maincomment FROM locations WHERE parent = ? AND id LIKE ? ORDER BY '; + return bless PciIds::DBQAny::new( $dbh, { + 'nodes-id' => $node.'id', + 'nodes-name' => $node.'name', + 'nodes-rid' => $node.'id DESC', + 'nodes-rname' => $node.'name DESC', + 'nodes-id-r' => $noder.'id', + 'nodes-name-r' => $noder.'name', + 'nodes-rid-r' => $noder.'id DESC', + 'nodes-rname-r' => $noder.'name DESC', + 'item' => 'SELECT parent, name, description, maincomment FROM locations WHERE id = ?', + 'login' => 'SELECT id FROM users WHERE login = ?', + 'email' => 'SELECT id FROM users WHERE email = ?', + 'adduser' => 'INSERT INTO users (login, email, passwd) VALUES(?, ?, ?)', + 'adduser-null' => 'INSERT users (email, passwd) VALUES(?, ?)', + 'loginfomail' => 'SELECT id, passwd, logtime, lastlog FROM users WHERE email = ?', + 'loginfoname' => 'SELECT id, passwd, logtime, lastlog, email FROM users WHERE login = ?', + 'resetinfo' => 'SELECT id, login, passwd FROM users WHERE email = ?', + 'changepasswd' => 'UPDATE users SET passwd = ? WHERE id = ?', + 'setlastlog' => 'UPDATE users SET logtime = now(), lastlog = ? WHERE id = ?', + 'rights' => 'SELECT rightId FROM rights WHERE userId = ?', + 'newitem' => 'INSERT INTO locations (id, parent) VALUES(?, ?)', + 'newcomment' => 'INSERT INTO history (location, owner, text, nodename, nodedescription) VALUES(?, ?, ?, ?, ?)', + 'history' => 'SELECT history.id, history.text, history.time, history.nodename, history.nodedescription, history.seen, users.login FROM history LEFT OUTER JOIN users ON history.owner = users.id WHERE history.location = ? ORDER BY history.time', + 'admindump' => 'SELECT + locations.id, locations.name, locations.description, locations.maincomment, musers.login, main.text, + history.id, history.text, history.nodename, history.nodedescription, users.login + FROM + locations INNER JOIN history ON history.location = locations.id + LEFT OUTER JOIN users ON history.owner = users.id + LEFT OUTER JOIN history AS main ON locations.maincomment = main.id + LEFT OUTER JOIN users AS musers ON main.owner = musers.id WHERE history.seen = "0" + ORDER BY locations.id, history.id + LIMIT 15',#Dumps all new comments with their senders and corresponding main comments and names + 'delete-hist' => 'DELETE FROM history WHERE id = ?', + 'mark-checked' => 'UPDATE history SET seen = 1 WHERE id = ?', + 'delete-item' => 'DELETE FROM locations WHERE id = ?', + 'set-maincomment' => 'UPDATE locations SET + maincomment = ?, + name = ( SELECT nodename FROM history WHERE id = ? ), + description = ( SELECT nodedescription FROM history WHERE id = ? ) + WHERE + id = ?', + 'profiledata' => 'SELECT email, xmpp, login, mailgather, xmppgather FROM users WHERE id = ?', + 'pushprofile' => 'UPDATE users SET xmpp = ?, login = ?, mailgather = ?, xmppgather = ? WHERE id = ?', + 'setemail' => 'UPDATE users SET email = ?, passwd = ? WHERE id = ?', + 'notifuser' => 'SELECT location, recursive FROM notifications WHERE user = ? ORDER BY location', + 'notifdata' => 'SELECT recursive, type, notification FROM notifications WHERE user = ? AND location = ?', + 'drop-notif' => 'DELETE FROM notifications WHERE user = ? AND location = ?', + 'new-notif' => 'INSERT INTO notifications (user, location, recursive, type, notification) VALUES (?, ?, ?, ?, ?)', + 'notify' => 'INSERT INTO pending (user, comment, notification, reason) SELECT DISTINCT user, ?, ?, ? FROM notifications WHERE ( notification = 2 OR notification = ? ) AND type <= ? AND ( location = ? OR ( SUBSTR( ?, 1, LENGTH( location ) ) = location ) )', + 'newtime-mail' => 'UPDATE users SET nextmail = FROM_UNIXTIME( UNIX_TIMESTAMP( NOW() ) + 60 * mailgather ) WHERE nextmail < NOW() AND EXISTS ( SELECT 1 FROM notifications WHERE ( notification = 0 OR notification = 2 ) AND type <= ? AND ( location = ? OR ( SUBSTR( ?, 1, LENGTH( location ) ) = location ) ) )', + 'newtime-xmpp' => 'UPDATE users SET nextxmpp = FROM_UNIXTIME( UNIX_TIMESTAMP( NOW() ) + 60 * xmppgather ) WHERE nextxmpp < NOW() AND EXISTS ( SELECT 1 FROM notifications WHERE ( notification = 1 OR notification = 2 ) AND type <= ? AND ( location = ? OR ( SUBSTR( ?, 1, LENGTH( location ) ) = location ) ) )', + 'mailout' => 'SELECT + pending.user, users.email, + pending.reason, history.text, history.nodename, history.nodedescription, history.time, + auth.login, history.location, locations.name, locations.description + FROM + pending + INNER JOIN users ON users.id = pending.user + INNER JOIN history ON history.id = pending.comment + INNER JOIN locations ON history.location = locations.id + INNER JOIN users AS auth ON auth.id = history.owner + WHERE + pending.notification = 0 + AND users.nextmail <= ? + ORDER BY + pending.user, pending.reason, history.time, history.location', + 'xmppout' => 'SELECT + pending.user, users.xmpp, + pending.reason, history.text, history.nodename, history.nodedescription, history.time, + auth.login, history.location, locations.name, locations.description + FROM + pending + INNER JOIN users ON users.id = pending.user + INNER JOIN history ON history.id = pending.comment + INNER JOIN locations ON history.location = locations.id + INNER JOIN users AS auth ON auth.id = history.owner + WHERE + pending.notification = 1 + AND users.nextxmpp <= ? + ORDER BY + pending.user, pending.reason, history.time, history.location', + 'dropnotifsxmpp' => 'DELETE FROM pending WHERE notification = 1 AND EXISTS ( SELECT 1 FROM users WHERE users.id = pending.user AND nextxmpp <= ? )', + 'dropnotifsmail' => 'DELETE FROM pending WHERE notification = 0 AND EXISTS ( SELECT 1 FROM users WHERE users.id = pending.user AND nextmail <= ? )', + 'time' => 'SELECT NOW()' + + } ); +} + +my %sorts = ( 'id' => 1, 'rid' => 1, 'name' => 1, 'rname' => 1 ); + +sub nodes( $$$$ ) { + my( $self, $parent, $args, $restrict ) = @_; + my $q = 'id'; + $q = $args->{'sort'} if( defined( $args->{'sort'} ) && defined( $sorts{$args->{'sort'}} ) ); + if( defined( $restrict ) && ( $restrict ne "" ) ) { + return $self->query( 'nodes-'.$q.'-r', [ $parent, $parent.'/'.$restrict.'%' ] ); + } else { + return $self->query( 'nodes-'.$q, [ $parent ] ); + } +} + +sub item( $$ ) { + my( $self, $id ) = @_; + my $result = $self->query( "item", [ $id ] ); + if( scalar @{$result} ) { + return $result->[ 0 ]; + } else { + return undef; + } +} + +sub hasLogin( $$ ) { + my( $self, $login ) = @_; + my $result = $self->query( 'login', [ $login ] ); + return scalar @{$result}; +} + +sub hasEmail( $$ ) { + my( $self, $email ) = @_; + my $result = $self->query( 'email', [ $email ] ); + return scalar @{$result}; +} + +sub addUser( $$$$ ) { + my( $self, $login, $email, $passwd ) = @_; + eval { + if( ( defined $login ) && ( $login ne '' ) ) { + $self->command( 'adduser', [ $login, $email, $passwd ] ); + } else { + $self->command( 'adduser-null', [ $email, $passwd ] ); + } + }; + if( $@ ) { + return 0; + } else { + return $self->last(); + } +} + +sub getLogInfo( $$ ) { + my( $self, $info ) = @_; + my $data; + if( $info =~ /@/ ) {#An email address + $data = $self->query( 'loginfomail', [ $info ] ); + } else { + $data = $self->query( 'loginfoname', [ $info ] ); + } + if( scalar @{$data} ) { + my( $id, $passwd, $logtime, $lastlog, $email ) = @{$data->[ 0 ]}; + my $logstring; + $logstring = "Last logged from $lastlog at $logtime" if( defined $logtime && defined $lastlog ); + $email = $info if( $info =~ /@/ ); + return( $id, $passwd, $email, $logstring ); + } else { + return undef; + } +} + +sub rights( $$ ) { + my( $self, $id ) = @_; + return $self->query( 'rights', [ $id ] ); +} + +sub setLastLog( $$$ ) { + my( $self, $id, $from ) = @_; + $self->command( 'setlastlog', [ $from, $id ] ); +} + +sub history( $$ ) { + my( $self, $addr ) = @_; + return $self->query( 'history', [ $addr ] ); +} + +sub submitItem( $$$ ) { + my( $self, $data, $auth ) = @_; + my( $addr ) = ( $data->{'address'} ); + return( 'exists', undef ) if( defined( $self->item( $addr->get(), 0 ) ) ); + eval { + $self->command( 'newitem', [ $addr->get(), $addr->parent()->get() ] ); + $self->command( 'newcomment', [ $addr->get(), $auth->{'authid'}, $data->{'text'}, $data->{'name'}, $data->{'description'} ] ); + + }; + if( $@ ) { + $self->rollback(); + return( 'internal: '.$@, undef ); + } + return( '', $self->last() ); +} + +sub submitComment( $$$$ ) { + my( $self, $data, $auth, $address ) = @_; + $self->command( 'newcomment', [ $address->get(), $auth->{'authid'}, $data->{'text'}, $data->{'name'}, $data->{'description'} ], 1 ); + return $self->last(); +} + +sub adminDump( $ ) { + return shift->query( 'admindump', [] ); +} + +sub deleteHistory( $$ ) { + my( $self, $id ) = @_; + $self->command( 'delete-hist', [ $id ] ); +} + +sub markChecked( $$ ) { + my( $self, $id ) = @_; + $self->command( 'mark-checked', [ $id ] ); +} + +sub deleteItem( $$ ) { + my( $self, $id ) = @_; + $self->command( 'delete-item', [ $id ] ); +} + +sub setMainComment( $$$ ) { + my( $self, $location, $comment ) = @_; + $self->command( 'set-maincomment', [ $comment, $comment, $comment, $location ] ); +} + +sub resetInfo( $$ ) { + my( $self, $mail ) = @_; + my $result = $self->query( 'resetinfo', [ $mail ] ); + if( scalar @{$result} ) { + return ( @{$result->[0]} ); + } else { + return undef; + } +} + +sub changePasswd( $$$ ) { + my( $self, $id, $passwd ) = @_; + $self->command( 'changepasswd', [ $passwd, $id ] ); +} + +sub profileData( $$ ) { + my( $self, $id ) = @_; + my %result; + ( $result{'email'}, $result{'xmpp'}, $result{'login'}, $result{'email_time'}, $result{'xmpp_time'} ) = @{$self->query( 'profiledata', [ $id ] )->[0]}; + return \%result; +} + +sub setEmail( $$$$ ) { + my( $self, $id, $email, $passwd ) = @_; + $self->command( 'setemail', [ $email, $passwd, $id ] ); +} + +sub pushProfile( $$$$$$ ) { + my( $self, $id, $login, $xmpp, $mailgather, $xmppgather ) = @_; + $self->command( 'pushprofile', [ $xmpp, $login, $mailgather, $xmppgather, $id ] ); +} + +sub notificationsUser( $$ ) { + my( $self, $uid ) = @_; + return $self->query( 'notifuser', [ $uid ] ); +} + +sub getNotifData( $$$ ) { + my( $self, $uid, $location ) = @_; + my $result = $self->query( 'notifdata', [ $uid, $location ] ); + if( @{$result} ) { + my( $recursive, $notification, $way ) = @{$result->[0]}; + return { + 'recursive' => $recursive, + 'notification' => $notification, + 'way' => $way }; + } else { + return { 'recursive' => 1 }; + } +} + +sub submitNotification( $$$$ ) { + my( $self, $uid, $location, $data ) = @_; + $self->command( 'drop-notif', [ $uid, $location ] ); + $self->command( 'new-notif', [ $uid, $location, $data->{'recursive'}, $data->{'notification'}, $data->{'way'} ] ) unless( $data->{'notification'} == 3 ); +} + +sub pushNotifications( $$$$$ ) { + my( $self, $location, $comment, $priority, $reason ) = @_; + $self->command( 'notify', [ $comment, 0, $reason, 0, $priority, $location, $location ] ); + $self->command( 'notify', [ $comment, 1, $reason, 1, $priority, $location, $location ] ); + $self->command( 'newtime-mail', [ $priority, $location, $location ] ); + $self->command( 'newtime-xmpp', [ $priority, $location, $location ] ); +} + +sub mailNotifs( $$ ) { + my( $self, $time ) = @_; + return $self->query( 'mailout', [ $time ] ); +} + +sub xmppNotifs( $$ ) { + my( $self, $time ) = @_; + return $self->query( 'xmppout', [ $time ] ); +} + +sub time( $ ) { + my( $self ) = @_; + return $self->query( 'time', [] )->[0]->[0]; +} + +sub dropNotifs( $$ ) { + my( $self, $time ) = @_; + $self->command( 'dropnotifsmail', [ $time ] ); + $self->command( 'dropnotifsxmpp', [ $time ] ); +} + +1; diff --git a/internet/impl/PciIds/DBQAny.pm b/internet/impl/PciIds/DBQAny.pm new file mode 100644 index 0000000..c282356 --- /dev/null +++ b/internet/impl/PciIds/DBQAny.pm @@ -0,0 +1,53 @@ +package PciIds::DBQAny; +use strict; +use warnings; +use DBI; + +sub new( $$ ) { + my( $dbh, $queries ) = @_; + my %qs; + foreach( keys %{$queries} ) { + $qs{$_} = $dbh->prepare( $queries->{$_} ); + } + return bless { + "dbh" => $dbh, + "queries" => \%qs + }; +} + +sub queryAll( $$$$ ) { + my( $self, $name, $params, $fetch ) = @_; + my $q = $self->{'queries'}->{$name}; + $q->execute( @{$params} );#Will die automatically + if( $fetch ) { + my @result = @{$q->fetchall_arrayref()};#Copy the array, finish() deletes the content + $q->finish(); + return \@result; + } +} + +sub query( $$$ ) { + my( $self, $name, $params ) = @_; + return queryAll( $self, $name, $params, 1 ); +} + +sub command( $$$ ) { + my( $self, $name, $params ) = @_; + queryAll( $self, $name, $params, 0 ); +} + +sub commit( $ ) { + shift->{'dbh'}->commit(); +} + +sub rollback( $ ) { + shift->{'dbh'}->rollback(); +} + +sub last( $ ) { + return shift->{'dbh'}->last_insert_id( undef, undef, undef, undef ); +} + +sub dbh( $ ) { return shift->{'dbh'}; } + +1; diff --git a/internet/impl/PciIds/Db.pm b/internet/impl/PciIds/Db.pm new file mode 100644 index 0000000..8ec5de3 --- /dev/null +++ b/internet/impl/PciIds/Db.pm @@ -0,0 +1,19 @@ +package PciIds::Db; +use strict; +use warnings; +use base 'Exporter'; +use PciIds::Config; +use DBI; + +our @EXPORT = qw( &connectDb ); + +sub connectDb() { + my ( $uri, $user, $passwd ) = confList( [ "dburi", "dbuser", "dbpasswd" ] ); + my $result = DBI->connect( $uri, $user, $passwd, { 'AutoCommit' => 0, 'RaiseError' => 1, 'PrintError' => 0 } ) or die "Could not connect to database $uri (".DBI->errstr.")\n"; +} + +checkConf( [ "dbuser", "dbpasswd" ] ); +defConf( { "dbname" => "pciids" } ); +defConf( { "dburi" => "dbi:mysql:".$config{"dbname"} } ); + +return 1; diff --git a/internet/impl/PciIds/Email.pm b/internet/impl/PciIds/Email.pm new file mode 100644 index 0000000..1043a9c --- /dev/null +++ b/internet/impl/PciIds/Email.pm @@ -0,0 +1,26 @@ +package PciIds::Email; +use strict; +use warnings; +use PciIds::Config; +use base 'Exporter'; + +our @EXPORT = qw(&sendMail); + +checkConf( [ 'from_addr', 'sendmail' ] ); +defConf( { 'sendmail' => '/usr/sbin/sendmail' } ); + +sub sendMail( $$$ ) { + my( $to, $subject, $body ) = @_; + my( $from, $sendmail ) = confList( [ 'from_addr', 'sendmail' ] ); + $body =~ s/^\.$/../gm; + open SENDMAIL, "|$sendmail -f$from $to" or die 'Can not send mail'; + print SENDMAIL "From: $from\n". + "To: $to\n". + "Subject: $subject\n". + "Content-Type: text/plain; charset=\"utf8\"\n". + "\n". + $body."\n.\n"; + close SENDMAIL or die "Sending mail failed: $!, $?"; +} + +1; diff --git a/internet/impl/PciIds/Html/Admin.pm b/internet/impl/PciIds/Html/Admin.pm new file mode 100644 index 0000000..a1b6cb1 --- /dev/null +++ b/internet/impl/PciIds/Html/Admin.pm @@ -0,0 +1,170 @@ +package PciIds::Html::Admin; +use strict; +use warnings; +use PciIds::Users; +use PciIds::Html::Util; +use PciIds::Html::Users; +use PciIds::Html::Forms; +use PciIds::Notifications; +use PciIds::Log; +use Apache2::Const qw(:common :http); + +sub genNewAdminForm( $$$$ ) { + my( $req, $args, $tables, $error ) = @_; + genHtmlHead( $req, 'Administration ‒ pending events', undef ); + print "

Administration ‒ pending events

\n"; + print "
".$error."
\n" if( defined $error ); + print '
\n"; + my $lastId; + my $started = 0; + my $cnt = 0; + my $hiscnt = 0; + my $subcnt; + foreach( @{$tables->adminDump()} ) { + my( $locId, $actName, $actDescription, $actCom, $actUser, $actText, + $com, $text, $name, $description, $user ) = @{$_}; + if( !defined( $lastId ) || ( $lastId ne $locId ) ) { + $lastId = $locId; + print "\n" if( $started ); + $started = 1; + print "
\n"; + my $addr = PciIds::Address::new( $locId ); + print "

".encode( $addr->pretty() )."

\n"; + print htmlDiv( 'name', '

'.encode( $actName ) ) if( defined( $actName ) ); + print htmlDiv( 'description', '

'.encode( $actDescription ) ) if( defined( $actDescription ) ); + print '

'.encode( $actText ) if( defined( $actText ) ); + print '

'.encode( $addr->parent()->pretty() )."" if( defined( $addr->parent() ) ); + print htmlDiv( 'author', '

'.encode( $actUser ) ) if( defined( $actUser ) ); + print "\n" if( defined( $subcnt ) ); + $subcnt = 0; + $cnt++; + print "\n"; + print "

I will decide later.\n"; + if( defined( $actCom ) ) { + print "
Keep current name.\n"; + } + print "
Delete item.\n"; + print "
Add comment:\n"; + print "
\n"; + print "
Set name:\n"; + print "
Set description:\n"; + print "
Text:\n"; + print "
\n"; + } + print "

\n"; + print "

".encode( $name ) if( defined( $name ) ); + print "

".encode( $description ) if( defined( $description ) ); + print '

'.encode( $text ) if( defined( $text ) ); + print "

".encode( $user ) if( defined( $user ) ); + print "

Use this one.\n" if( defined( $name ) && ( $name ne "" ) ); + $hiscnt ++; + print "
Delete comment.\n"; + print "

\n"; + $subcnt ++; + print "\n"; + } + print "\n" if( defined( $subcnt ) ); + if( $started ) { + print "
\n" if( $started ); + print "

\n"; + print "\n"; + } else { + print "

No pending comments.\n"; + } + print "

\n"; + genHtmlTail(); + return OK; +} + +sub adminForm( $$$$ ) { + my( $req, $args, $tables, $auth ) = @_; + if( defined( $auth->{'authid'} ) && hasRight( $auth->{'accrights'}, 'validate' ) ) { + return genNewAdminForm( $req, $args, $tables, undef ); + } else { + return notLoggedComplaint( $req, $args, $auth ); + } +} + +sub markAllChecked( $$$$ ) { + my( $tables, $itemNum, $deleted, $authid ) = @_; + my $i; + my $subcnt = getFormValue( "subcnt-$itemNum", 0 ); + for( $i = 1; $i <= $subcnt; ++ $i ) { + my $id = getFormValue( "sub-$itemNum-$i", undef ); + next unless( defined( $id ) ); + next if( $deleted->{$id} );#Do not update this one, already deleted + $tables->markChecked( $id ); + tulog( $authid, "Comment checked $id" ); + } +} + +sub submitAdminForm( $$$$ ) { + my( $req, $args, $tables, $auth ) = @_; + my $authid = $auth->{'authid'}; + if( defined( $authid ) && hasRight( $auth->{'accrights'}, 'validate' ) ) { + my $errors = ''; + my %deleted; + my $maxcnt = getFormValue( 'max-cnt', 0 ); + my $maxhiscnt = getFormValue( 'max-hiscnt', 0 ); + for( my $i = 1; $i <= $maxhiscnt; $i ++ ) { + my $del = getFormValue( "delete-$i", "" ); + $del =~ s/^delete-//; + if( $del ne '' ) { + $deleted{$del} = 1; + $tables->deleteHistory( $del ); + tulog( $authid, "Comment deleted $del" ); + } + } + for( my $i = 1; $i <= $maxcnt; $i ++ ) { + my $action = getFormValue( "action-$i", 'ignore' ); + my $loc = getFormValue( "loc-$i", undef ); + next unless( defined( $loc ) ); + my( $text, $name, $description ) = ( + getFormValue( "text-$i", undef ), + getFormValue( "name-$i", undef ), + getFormValue( "description-$i", undef ) ); + if( defined( $description ) && ( $description ne '' ) && ( !defined( $name ) || ( length $name < 3 ) ) ) { + if( $errors eq '' ) { + $errors = '

'; + } else { + $errors .= '
'; + } + $errors .= "$loc - You need to provide name if you provide description\n"; + next; + } + if( ( defined( $name ) && ( length $name >= 3 ) ) || ( defined( $text ) && ( $text ne '' ) ) ) { #Submited comment + my $addr = PciIds::Address::new( $loc ); + my $comId = $tables->submitComment( { 'name' => $name, 'description' => $description, 'explanation' => $text }, $auth, $addr ); + my $main = defined $name && ( $name ne '' ); + notify( $tables, $addr->get(), $comId, $main ? 2 : 0, $main ? 2 : 1 ); + $tables->markChecked( $comId ); + tulog( $authid, "Comment created (admin) $comId $loc ".logEscape( $name )." ".logEscape( $description )." ".logEscape( $text ) ); + if( defined( $name ) && ( length $name >= 3 ) ) { + $tables->setMainComment( $loc, $comId ); + tulog( $authid, "Item main comment changed $loc $comId" ); + $action = 'keep'; + } + } + next if( $action eq 'ignore' ); + if( $action eq 'keep' ) { + markAllChecked( $tables, $i, \%deleted, $authid ); + } elsif( $action eq 'delete' ) { + eval { + $tables->deleteItem( $loc ); + tulog( $authid, "Item deleted (recursive) $loc" ); + } #Ignore if it was already deleted by superitem + } elsif( my( $setId ) = ( $action =~ /set-(.*)/ ) ) { + next if( $deleted{$setId} ); + $tables->setMainComment( $loc, $setId ); + notify( $tables, $loc, $setId, 2, 2 ); + tulog( $authid, "Item main comment changed $loc $setId" ); + markAllChecked( $tables, $i, \%deleted, $authid ); + } + } + return genNewAdminForm( $req, $args, $tables, $errors ); + } else { + return notLoggedComplaint( $req, $args, $auth ); + } +} + +1; diff --git a/internet/impl/PciIds/Html/Changes.pm b/internet/impl/PciIds/Html/Changes.pm new file mode 100644 index 0000000..ff5242b --- /dev/null +++ b/internet/impl/PciIds/Html/Changes.pm @@ -0,0 +1,137 @@ +package PciIds::Html::Changes; +use strict; +use PciIds::Html::Users; +use PciIds::Html::List; +use PciIds::Html::Util; +use PciIds::Html::Forms; +use PciIds::Notifications; +use PciIds::Log; +use Apache2::Const qw(:common :http); + +sub genNewItemForm( $$$$$ ) { + my( $req, $args, $tables, $error, $values ) = @_; + my( $ok, $parent, $name, $description, $address ) = loadItem( $tables, $req->uri() ); + return NOT_FOUND unless( $ok ); + my $prettyAddr = encode( $address->pretty() ); + genHtmlHead( $req, "$prettyAddr - add new item", undef ); + print "

$prettyAddr - add new item

\n"; + print "
$error
\n" if( defined $error ); + print "
\n"; + genFormEx( [ [ 'input', 'Id:', 'text', 'id', 'maxlength="50"' ], + [ 'input', 'Name:', 'text', 'name', 'maxlength="200"' ], + [ 'input', 'Description*:', 'text', 'description', 'maxlength="1024"' ], + [ 'textarea', 'Text*:', undef, 'text', 'rows="5" cols="50"' ], + [ 'input', '', 'submit', 'submit', 'value="Submit"' ] ], $values ); + print '
'; + print '

Items marked with * are optional.'; + genHtmlTail(); + return OK; +} + +sub newItemForm( $$$$ ) { + my( $req, $args, $tables, $auth ) = @_; + if( defined $auth->{'authid'} ) {#Logged in alright + return genNewItemForm( $req, $args, $tables, undef, {} ); + } else { + return notLoggedComplaint( $req, $args, $auth ); + } +} + +sub newItemSubmit( $$$$ ) { + my( $req, $args, $tables, $auth ) = @_; + if( defined $auth->{'authid'} ) { + my( $pok, $parent, $pname, $pdescription, $paddress ) = loadItem( $tables, $req->uri() ); + return NOT_FOUND unless( $pok ); + my( $data, $error ) = getForm( { + 'id' => sub{ return ( length shift ) ? undef : 'Please, provide the ID'; }, #Checked at the bottom and added as address + 'name' => sub { + my( $name ) = @_; + return 'Too short for a name' if( length $name < 3 ); + return 'Lenght limit of the name is 200 characters' if( length $name > 200 ); + return undef; + }, + 'description' => sub { return ( length shift > 1024 ) ? 'Description can not be longer than 1024 characters' : undef; }, + 'text' => sub { return ( length shift > 1024 ) ? 'Text can not be longer than 1024 characters' : undef; } + }, [ sub { my( $data ) = @_; + my $errstr; + return undef unless( length $data->{'id'} );#No address, so let it for the first check + ( $data->{'address'}, $errstr ) = $paddress->append( $data->{'id'} ); + return $errstr; + }, sub { return $paddress->canAddItem() ? undef : 'Can not add items here'; } ] ); + return genNewItemForm( $req, $args, $tables, $error, $data ) if( defined $error ); + my( $result, $comName ) = $tables->submitItem( $data, $auth ); + if( $result eq 'exists' ) { + genHtmlHead( $req, 'ID collision', undef ); + print '

ID collision

'; + print '

This ID already exists. Have a look at it'; + genHtmlTail(); + return OK; + } elsif( $result ) { + die "Failed to submit new item: $result\n"; + } + notify( $tables, $data->{'address'}->get(), $comName, 2, 0 ); + tulog( $auth->{'authid'}, "Item created ".$data->{'address'}->get()." ".logEscape( $data->{'name'} )." ".logEscape( $data->{'description'} )." ".logEscape( $data->{'text'} )." $comName" ); + return HTTPRedirect( $req, '/read/'.$data->{'address'}->get().'?action=list' ); + } else { + return notLoggedComplaint( $req, $args, $auth ); + } +} + +sub genNewCommentForm( $$$$$ ) { + my( $req, $args, $tables, $error, $values ) = @_; + my( $ok, $parent, $name, $description, $address ) = loadItem( $tables, $req->uri() ); + return NOT_FOUND unless( $ok ); + my $prettyAddr = encode( $address->pretty() ); + genHtmlHead( $req, "$prettyAddr - add a comment to discussion", undef ); + print "

$prettyAddr - add a comment to discussion

\n"; + print "
$error
\n" if( defined $error ); + print "
\n"; + genFormEx( [ [ 'textarea', 'Text:', undef, 'text', 'rows="5" cols="50"' ], + [ 'input', 'Name*:', 'text', 'name', 'maxlength="200"' ], + [ 'input', 'Description*:', 'text', 'description', 'maxlength="1024"' ], + [ 'input', '', 'submit', 'submit', 'value="Submit"' ] ], $values ); + print '
'; + print '

Items marked with * are optional, use them only if you want to change the name and description.'; + print '

If you specify description must include name too.'; + genHtmlTail(); + return OK; +} + +sub newCommentForm( $$$$ ) { + my( $req, $args, $tables, $auth ) = @_; + if( defined $auth->{'authid'} ) { + return genNewCommentForm( $req, $args, $tables, undef, {} ); + } else { + return notLoggedComplaint( $req, $args, $auth ); + } +} + +sub newCommentSubmit( $$$$ ) { + my( $req, $args, $tables, $auth ) = @_; + if( defined $auth->{'authid'} ) { + my( $ok, $parent, $name, $description, $address ) = loadItem( $tables, $req->uri() ); + return NOT_FOUND unless( $ok ); + my( $data, $error ) = getForm( { + 'name' => sub { return ( length shift > 200 ) ? 'Lenght limit of the name is 200 characters' : undef; }, + 'description' => sub { return ( length shift > 1024 ) ? 'Description can not be longer than 1024 characters' : undef; }, + 'text' => sub { + my( $expl ) = @_; + return 'Text can not be longer than 1024 characters' if ( length $expl > 1024 ); + return 'You must provide the text of comment' unless( length $expl ); + return undef; + } + }, [ sub { my( $data ) = @_; + return 'You must provide name too' if( ( length $data->{'description'} ) && ( ! length $data->{'name'} ) ); + return undef; + }, sub { return $address->canAddComment() ? undef : 'You can not discuss this item'; } ] ); + return genNewCommentForm( $req, $args, $tables, $error, $data ) if( defined $error ); + my $hid = $tables->submitComment( $data, $auth, $address ); + tulog( $auth->{'authid'}, "Comment created $hid ".$address->get()." ".logEscape( $data->{'name'} )." ".logEscape( $data->{'description'} )." ".logEscape( $data->{'text'} ) ); + notify( $tables, $address->get(), $hid, ( defined $name && ( $name ne '' ) ) ? 1 : 0, 1 ); + return HTTPRedirect( $req, '/read/'.$address->get().'?action=list' ); + } else { + return notLoggedComplaint( $req, $args, $auth ); + } +} + +1; diff --git a/internet/impl/PciIds/Html/Debug.pm b/internet/impl/PciIds/Html/Debug.pm new file mode 100644 index 0000000..b92270c --- /dev/null +++ b/internet/impl/PciIds/Html/Debug.pm @@ -0,0 +1,21 @@ +package PciIds::Html::Debug; +use strict; +use warnings; +use Apache2::Const qw(:common :http); +use PciIds::Html::Util; + +sub test( $$$$ ) { + my( $req, $args, $tables, $auth ) = @_; + genHtmlHead( $req, 'Test', undef ); + print '

Logged in: '.$auth->{'authid'} if( defined $auth->{'authid'} ); + print $auth->{'logerror'} if( defined $auth->{'logerror'} ); + return OK unless defined $auth->{'authid'}; + print "

"; + foreach( keys %ENV ) { + print encode( "$_: $ENV{$_}
" ); + } + genHtmlTail(); + return OK; +} + +1; diff --git a/internet/impl/PciIds/Html/Format.pm b/internet/impl/PciIds/Html/Format.pm new file mode 100644 index 0000000..1544d20 --- /dev/null +++ b/internet/impl/PciIds/Html/Format.pm @@ -0,0 +1,36 @@ +package PciIds::Html::Format; +use strict; +use warnings; +use PciIds::Html::Util; +use base 'Exporter'; + +our @EXPORT = qw(&htmlFormatTable); + +sub htmlFormatTable( $$$$$$ ) { + my( $data, $cols, $headers, $funcs, $filter, $trHead ) = @_; + $trHead = sub { return ''; } unless( defined $trHead ); + foreach my $line ( @{$data} ) { + next unless( &{$filter}( $line ) ); + my $i; + print ''; + for( $i = 0; $i < $cols; $i ++ ) { + my( $header, $func ); + if( ( scalar( @{$headers} ) > $i ) && defined( $headers->[ $i ] ) ) { + $header = $headers->[ $i ]; + } else { + $header = ''; + } + if( ( scalar( @{$funcs} ) > $i ) && defined( $funcs->[ $i ] ) ) { + $func = $funcs->[ $i ]; + } else { + $func = \&encode; + } + my $data = &{$func}( $line->[ $i ] ); + $data = "" unless( defined( $data ) ); + print $header.$data.''; + } + print "\n"; + } +} + +1; diff --git a/internet/impl/PciIds/Html/Forms.pm b/internet/impl/PciIds/Html/Forms.pm new file mode 100644 index 0000000..3d1b83a --- /dev/null +++ b/internet/impl/PciIds/Html/Forms.pm @@ -0,0 +1,68 @@ +package PciIds::Html::Forms; +use strict; +use warnings; +use base 'Exporter'; +use CGI; +use HTML::Entities; + +our @EXPORT = qw(&genForm &getForm &genFormEx &getFormValue &genRadios); + +sub genFormEx( $$ ) { + my( $inputs, $values ) = @_; + foreach( @{$inputs} ) { + my( $kind, $label, $type, $name, $other ) = @{$_}; + $other = '' unless( defined $other ); + print ''.$label.'<'.$kind.( ( defined $type ) ? ' type="'.$type.'"' : '' ).' name="'.$name.'" '.$other.( defined( $values->{$name} && ( $label ne 'textarea' ) ) ? 'value="'.encode_entities( $values->{$name} ).'" ' : '' ).">\n"; + if( $kind eq 'textarea' ) { + print encode_entities( $values->{$name} ) if( defined( $values->{$name} ) ); + print "\n"; + } + } +} + +sub genForm( $$ ) { + my( $inputs, $values ) = @_; + my @transformed; + foreach( @{$inputs} ) { + my @ln = @{$_}; + unshift @ln, "input"; + push @transformed, \@ln; + } + genFormEx( \@transformed, $values ); +} + +sub getFormValue( $$ ) { + my( $name, $default ) = @_; + my $result = CGI::param( $name ); + $result = $default unless( defined( $result ) ); + return $result; +} + +sub getForm( $$ ) { + my( $data, $checks ) = @_; + my %result; + my @errors; + foreach( keys %{$data} ) { + my $d = CGI::param( $_ ); + my $sub = $data->{$_}; + my ( $err, $newval ) = &{$sub}( $d ) if( defined $sub ); + $d = $newval if( defined $newval ); + push @errors, $err if( defined $err ); + $result{$_} = $d; + } + foreach( @{$checks} ) { + my $err = &{$_}( \%result ); + push @errors, $err if( defined $err ); + } + return ( \%result, ( @errors ) ? ( join '

', ( '', @errors ) ) : undef ); +} + +sub genRadios( $$$ ) { + my( $list, $name, $default ) = @_; + foreach( @{$list} ) { + my( $label, $value ) = @{$_}; + print " $label
\n"; + } +} + +1; diff --git a/internet/impl/PciIds/Html/Handler.pm b/internet/impl/PciIds/Html/Handler.pm new file mode 100644 index 0000000..4a07f25 --- /dev/null +++ b/internet/impl/PciIds/Html/Handler.pm @@ -0,0 +1,74 @@ +package PciIds::Html::Handler; +use strict; +use warnings; +use PciIds::Db; +use PciIds::Html::Tables; +use PciIds::Html::Util; +use PciIds::Html::List; +use PciIds::Html::Users; +use PciIds::Html::Debug; +use PciIds::Html::Changes; +use PciIds::Html::Admin; +use PciIds::Html::Notifications; +use PciIds::Notifications; +use Apache2::Const qw(:common :http); + +my $dbh = connectDb(); +my $tables = PciIds::Html::Tables::new( $dbh ); + +my %handlers = ( + 'GET' => { + 'list' => \&PciIds::Html::List::list,#List items + '' => \&PciIds::Html::List::list, + #Database changes + 'newitem' => \&PciIds::Html::Changes::newItemForm, + 'newcomment' => \&PciIds::Html::Changes::newCommentForm, + #Registering users + 'register' => \&PciIds::Html::Users::registerForm, + 'register-confirm' => \&PciIds::Html::Users::confirmForm, + #Logins + 'login' => \&PciIds::Html::Users::loginForm, + 'logout' => \&PciIds::Html::Users::logout, + 'respass' => \&PciIds::Html::Users::resetPasswdForm, + 'respass-confirm' => \&PciIds::Html::Users::resetPasswdConfirmForm, + #User profile + 'profile' => \&PciIds::Html::Users::profileForm, + #Admin + 'admin' => \&PciIds::Html::Admin::adminForm, + #Some debug + 'test' => \&PciIds::Html::Debug::test, + #Notifications + 'notifications' => \&PciIds::Html::Notifications::notifForm + }, + 'POST' => { + 'newitem' => \&PciIds::Html::Changes::newItemSubmit, + 'newcomment' => \&PciIds::Html::Changes::newCommentSubmit, + 'register' => \&PciIds::Html::Users::registerSubmit, + 'register-confirm' => \&PciIds::Html::Users::confirmSubmit, + 'login' => \&PciIds::Html::Users::loginSubmit, + 'respass' => \&PciIds::Html::Users::resetPasswdFormSubmit, + 'respass-confirm' => \&PciIds::Html::Users::resetPasswdConfirmFormSubmit, + 'profile' => \&PciIds::Html::Users::profileFormSubmit, + 'admin' => \&PciIds::Html::Admin::submitAdminForm, + 'notifications' => \&PciIds::Html::Notifications::notifFormSubmit + } +); + +sub handler( $$ ) { + my( $req, $hasSSL ) = @_; + return DECLINED if( $req->uri() =~ /^\/(static)\// ); + my $args = parseArgs( $req->args() ); + my $action = $args->{'action'}; + $action = '' unless( defined $action ); + my $method = $handlers{$req->method()}; + return HTTP_METHOD_NOT_ALLOWED unless( defined $method );#Can't handle this method + my $sub = $method->{$action}; + return HTTP_BAD_REQUEST unless( defined $sub );#I do not know this action for given method + my $auth = checkLogin( $req, $tables );#Check if logged in + $auth->{'ssl'} = $hasSSL; + my $result = &{$sub}( $req, $args, $tables, $auth );#Just do the right thing + $tables->commit(); + return $result; +} + +1; diff --git a/internet/impl/PciIds/Html/HandlerPlain.pm b/internet/impl/PciIds/Html/HandlerPlain.pm new file mode 100644 index 0000000..5aa267e --- /dev/null +++ b/internet/impl/PciIds/Html/HandlerPlain.pm @@ -0,0 +1,10 @@ +package PciIds::Html::HandlerPlain; +use strict; +use warnings; +use PciIds::Html::Handler; + +sub handler( $ ) { + return PciIds::Html::Handler::handler( shift, 0 ); +} + +1; diff --git a/internet/impl/PciIds/Html/HandlerSSL.pm b/internet/impl/PciIds/Html/HandlerSSL.pm new file mode 100644 index 0000000..4a7f7c6 --- /dev/null +++ b/internet/impl/PciIds/Html/HandlerSSL.pm @@ -0,0 +1,10 @@ +package PciIds::Html::HandlerSSL; +use strict; +use warnings; +use PciIds::Html::Handler; + +sub handler( $ ) { + return PciIds::Html::Handler::handler( shift, 1 ); +} + +1; diff --git a/internet/impl/PciIds/Html/List.pm b/internet/impl/PciIds/Html/List.pm new file mode 100644 index 0000000..aaa7170 --- /dev/null +++ b/internet/impl/PciIds/Html/List.pm @@ -0,0 +1,77 @@ +package PciIds::Html::List; +use strict; +use warnings; +use PciIds::Address; +use PciIds::Html::Util; +use Apache2::Const qw(:common :http); +use base 'Exporter'; + +our @EXPORT = qw(&loadItem); + +sub loadItem( $$ ) { + my( $tables, $uri ) = @_; + my $address = PciIds::Address::new( $uri ); + return ( 0 ) unless( defined $address ); + my $item = $tables->item( $address->get() ); + return ( 0 ) unless( defined $item ); + my( $parent, $name, $description, $maincomment ) = @{$item}; + return ( 1, $parent, $name, $description, $address, $maincomment ); +} + +sub list( $$$$ ) { + my( $req, $args, $tables, $auth ) = @_; + my( $ok, $parent, $name, $description, $address, $mid ) = loadItem( $tables, $req->uri() ); + return NOT_FOUND unless( $ok ); + my $id = $address->pretty(); + genHtmlHead( $req, $id, undef ); + print '

'.encode( $id ).'

'; + genMenu( $address, $args, $auth ); + print htmlDiv( 'name', '

'.encode( $name ) ) if( defined( $name ) ); + print htmlDiv( 'description', '

'.encode( $description ) ) if( defined( $description ) ); + print '

'.encode( $address->parent()->pretty() )."" if( defined( $address->parent() ) ); + my $diss = 0; + my $comment; + foreach $comment ( @{$tables->history( $address->get() )} ) { + unless( $diss ) { + print "

\n

Discussion

"; + $diss = 1; + } + my( $id, $text, $time, $name, $description, $seen, $user ) = @{$comment}; + my $type = $seen ? 'comment' : 'unseen-comment'; + $type = 'main-comment' if( defined( $mid ) && ( $id == $mid ) ); + print "
\n"; + print "

Name: ".encode( $name )."\n" if( defined( $name ) && ( $name ne '' ) ); + print "

Description: ".encode( $description )."\n" if( defined( $description ) && ( $description ne '' ) ); + if( defined( $text ) && ( $text ne '' ) ) { + $text = encode( $text ); + $text =~ s/\n/
/g; + print "

$text\n"; + } + print "

".encode( $user )."\n" if( defined( $user ) ); + print "

".encode( $time )."\n"; + print "

\n"; + } + print "
\n" if( $diss ); + unless( $address->leaf() ) { + print "

Subitems

\n"; + my $restricts = $address->defaultRestrictList(); + if( scalar @{$restricts} ) { + print "

"; + my $url = '/read/'.$address->get().buildExcept( 'restrict', $args ).'?restrict='; + foreach( @{$restricts} ) { + print "".$_->[1]." "; + } + } + my $url = '/read/'.$address->get().buildExcept( 'sort', $args ); + my $sort = ( $args->{'sort'} or 'id' ); + my( $sort_id, $sort_name ) = ( ( $sort eq 'id' ? 'rid' : 'id' ), ( $sort eq 'name' ? 'rname' : 'name' ) ); + genTableHead( 'subnodes', [ 'Id', 'Name', 'Description' ] ); + $args->{'restrict'} = $address->defaultRestrict() unless( defined( $args->{'restrict'} ) ); + $tables->nodes( $address->get(), $args ); + genTableTail(); + } + genHtmlTail(); + return OK; +} + +1; diff --git a/internet/impl/PciIds/Html/Notifications.pm b/internet/impl/PciIds/Html/Notifications.pm new file mode 100644 index 0000000..8dcdaed --- /dev/null +++ b/internet/impl/PciIds/Html/Notifications.pm @@ -0,0 +1,87 @@ +package PciIds::Html::Notifications; +use strict; +use warnings; +use PciIds::Html::Util; +use PciIds::Html::Forms; +use PciIds::Html::Users; +use PciIds::Address; +use Apache2::Const qw(:common :http); + +sub genNotifForm( $$$$$$ ) { + my( $req, $args, $tables, $auth, $error, $data ) = @_; + my $addr = PciIds::Address::new( $req->uri() ); + genHtmlHead( $req, $addr->pretty().' - notifications', undef ); + print "

".$addr->pretty()." - notifications

\n"; + print "
$error
\n" if( defined $error ); + my $uri = $addr->get(); + my $notifs = $tables->notificationsUser( $auth->{'authid'} ); + my $started; + foreach( @{$notifs} ) { + my( $location, $recursive ) = @{$_}; + if( ( substr( $uri, 0, length $location ) eq $location ) && $recursive && ( length $location < length $uri ) ) { + unless( $started ) { + print "

Item already covered by

\n" if( $started ); + print "
\n"; + print "

{'recursive'} ? " checked='checked'" : "" )."> Recursive\n"; + print "

Notification level

\n"; + print "

\n"; + genRadios( [ [ 'None', '3' ], [ 'Main comment & new subitem', '2' ], [ 'Description', '1' ], [ 'Comment', '0' ] ], 'notification', ( defined $data->{'notification'} ) ? $data->{'notification'} : '3' ); + print "

Notification way

\n"; + print "

\n"; + genRadios( [ [ 'Email', '0' ], [ 'Xmpp', '1' ], [ 'Both', '2' ] ], 'way', ( defined $data->{'way'} ) ? $data->{'way'} : '0' ); + print "

\n"; + print "

\n"; + if( @{$notifs} ) { + print "

All notifications

\n"; + } + print "Back to browsing\n"; + genHtmlTail(); + return OK; +} + +sub notifForm( $$$$ ) { + my( $req, $args, $tables, $auth ) = @_; + if( defined $auth->{'authid'} ) { + return genNotifForm( $req, $args, $tables, $auth, undef, $tables->getNotifData( $auth->{'authid'}, PciIds::Address::new( $req->uri() )->get() ) ); + } else { + return notLoggedComplaint( $req, $args, $auth ); + } +} + +sub range( $$$ ) { + my( $value, $name, $max ) = @_; + return ( "Invalid number in $name", 0 ) if $value !~ /\d+/; + return ( "Invalid range in $name", 0 ) if ( $value < 0 ) || ( $value > $max ); + return undef; +} + +sub notifFormSubmit( $$$$ ) { + my( $req, $args, $tables, $auth ) = @_; + return notLoggedComplaint( $req, $args, $auth ) unless defined $auth->{'authid'}; + my( $data, $error ) = getForm( { + 'notification' => sub { return range( shift, "notification", 3 ); }, + 'way' => sub { return range( shift, "way", 2 ); }, + 'recursive' => sub { + my $value = shift; + return ( undef, 1 ) if ( defined $value ) && ( $value eq 'recursive' ); + return ( undef, 0 ) if ( !defined $value ) || ( $value eq '' ); + return ( 'Invalid value in recursive', 0 ); + } + }, [] ); + return genNotifForm( $req, $args, $tables, $auth, $error, $data ) if defined $error; + $tables->submitNotification( $auth->{'authid'}, PciIds::Address::new( $req->uri() )->get(), $data ); + return HTTPRedirect( $req, setAddrPrefix( $req->uri(), 'read' ).buildExcept( 'action', $args )."?action=list" ); +} + +1; diff --git a/internet/impl/PciIds/Html/Tables.pm b/internet/impl/PciIds/Html/Tables.pm new file mode 100644 index 0000000..2e916b3 --- /dev/null +++ b/internet/impl/PciIds/Html/Tables.pm @@ -0,0 +1,26 @@ +package PciIds::Html::Tables; +use strict; +use warnings; +use base 'PciIds::DBQ'; +use PciIds::Html::Format; +use PciIds::Address; + +sub new( $ ) { + my( $dbh ) = @_; + return bless PciIds::DBQ::new( $dbh ); +} + +sub formatLink( $ ) { + my $address = PciIds::Address::new( shift ); + return ''.$address->tail().''; +} + +sub nodes( $$$ ) { + my( $self, $parent, $args ) = @_; + my $restrict = $args->{'restrict'}; + $restrict = '' unless( defined $restrict ); + $restrict = PciIds::Address::new( $parent )->restrictRex( $restrict );#How do I know if the restrict is OK? + htmlFormatTable( PciIds::DBQ::nodes( $self, $parent, $args, $restrict ), 3, [], [ \&formatLink ], sub { 1; }, sub { return ' class="'.( defined( shift->[ 3 ] ) ? 'item' : 'unnamedItem' ).'"'; } ); +} + +1; diff --git a/internet/impl/PciIds/Html/Users.pm b/internet/impl/PciIds/Html/Users.pm new file mode 100644 index 0000000..bea6669 --- /dev/null +++ b/internet/impl/PciIds/Html/Users.pm @@ -0,0 +1,471 @@ +package PciIds::Html::Users; +use strict; +use warnings; +use PciIds::Html::Util; +use PciIds::Html::Forms; +use PciIds::Email; +use PciIds::Users; +use CGI; +use CGI::Cookie; +use Apache2::Const qw(:common); +use Apache2::SubRequest; +use APR::Table; + +use base 'Exporter'; + +our @EXPORT = qw(&checkLogin ¬LoggedComplaint); + +sub genRegisterForm( $$$$ ) { + my( $req, $args, $error, $values ) = @_; + genHtmlHead( $req, 'Register a new user', undef ); + print '

Register a new user

'; + print '
'.$error.'
' if( defined $error ); + print '
+ '; + genForm( [ [ 'Email:', 'text', 'email', 'maxlength="255"' ], + [ '', 'submit', 'register', 'value="Register"' ] ], $values ); + print '
'; + genHtmlTail(); + return OK; +} + +sub registerForm( $$ ) {#Form for registering a new user + my( $req, $args ) = @_; + return genRegisterForm( $req, $args, undef, {} ); +} + +sub loginCheck( $$ ) { + my( $login, $tables ) = @_; + return undef if( ( not defined $login ) || ( $login eq '' ) );#empty login is ok + return 'Login too long' if( ( length $login ) > 50 ); + return 'Login contains invalid characters' unless( $login =~ /^[-_a-zA-Z0-9]+$/ ); + return 'This login already exists' if( $tables->hasLogin( $login ) ); + return undef; +} + +sub emailCheck( $$ ) { + my( $email, $tables ) = @_; + my $newmail; + return 'Does not look like an email address' unless ( ( $newmail ) = ( $email =~ /^([^,? "'`;]+@[^@,?\/ "'`;]+)$/ ) );#make sure the mail is not only reasonable looking, but safe to work with too + return 'Email too long' if length $newmail > 255; + return 'An account for this email address already exists' if( $tables->hasEmail( $newmail ) ); + return ( undef, $newmail ); +} + +sub registerSubmit( $$$ ) {#A registration form has been submited + my( $req, $args, $tables ) = @_; + my( $data, $error ) = getForm( { + 'email' => sub { + return emailCheck( shift, $tables ); + } + }, [] ); + return genRegisterForm( $req, $args, $error, $data ) if( defined $error ); + my $site = $req->hostname(); + my $url = 'https://'.$req->hostname().setAddrPrefix( $req->uri(), 'mods' ); + sendMail( $data->{'email'}, 'Confirm registration', "Someone, probably you, requested registration of this address\n". + "for the $site site. If it wasn't you, please ignore this email message.\n". + "\nOtherwise, please continue by filling in the form at this address:". + "\n".$url.'?action=register-confirm?email='.$data->{'email'}.'?confirm='.emailConfirm( $data->{'email'} )."\n". + "\nThank you\n". + "\n(This is an autogenerated email, do not respond to it)" ); + genHtmlHead( $req, 'Registration email sent', undef ); + print '

Register email sent

+

+ An email containing further information has been sent to you. + Please follow these instruction to finish the registration process.'; + genHtmlTail(); + return OK; +} + +sub genConfirmForm( $$$$ ) { + my( $req, $args, $error, $values ) = @_; + genHtmlHead( $req, 'Confirm registration', undef ); + print '

Confirm registration

'; + print '
'.$error.'
' if( defined $error ); + print '

Email address: '.encode( $values->{'email'} ); + print '

'; + print ''; + print ''; + genForm( [ [ 'Login (Optional):', 'text', 'login', 'maxlength="50"' ], + [ 'Password:', 'password', 'password' ], + [ 'Confirm password:', 'password', 'confirm_password' ], + [ '', 'submit', 'register', 'value=Register' ] ], $values ); + print '
'; + genHtmlTail(); + return OK; +} + +sub usedAddress( $ ) { + my( $req ) = @_; + genHtmlHead( $req, 'Used address', undef ); + print '

Used address

+
+

+ An account for this address is already registered. + Please, start again with requesting a registration email or log in. +

'; + genHtmlTail(); + return 0; +} + +sub checkRegHash( $$$$ ) { + my( $req, $tables, $email, $hash ) = @_; + if( ! checkConfirmHash( $email, $hash ) ) { + genHtmlHead( $req, 'Invalid registration request', undef ); + print '

Invalid registration request

+
+

+ This registration request is invalid. + Are you sure you got it from the registration email? +

'; + genHtmlTail(); + return 0; + } elsif( $tables->hasEmail( $email ) ) { + return usedAddress( $req ); + } else { + return 1; + } +} + +sub confirmForm( $$$$ ) { + my( $req, $args, $tables, $auth ) = @_; + return HTTPRedirect( $req, 'https://'.$req->hostname().$req->uri().buildArgs( $args ) ) unless $auth->{'ssl'}; + if( ! checkRegHash( $req, $tables, $args->{'email'}, $args->{'confirm'} ) ) { + return OK; + } else { + return genConfirmForm( $req, $args, undef, $args ); + } +} + +sub passLenCheck( $ ) { + my( $pass ) = @_; + return ( ( length $pass ) >= 4 ) ? undef : 'Password must have at least 4 characters'; +} + +sub passSameCheck( $ ) { + my( $data ) = @_; + return ( ( ( defined $data->{'password'} ) != ( defined $data->{'confirm_password'} ) ) || ( ( defined $data->{'password'} ) && ( $data->{'password'} ne $data->{'confirm_password'} ) ) ) ? 'Passwords do not match' : undef; +} + +sub confirmSubmit( $$$ ) { + my( $req, $args, $tables ) = @_; + my( $data, $error ) = getForm( { + 'email' => sub { + return emailCheck( shift, $tables ); + }, + 'confirm' => undef, + 'login' => sub { + return loginCheck( shift, $tables ); + }, + 'password' => \&passLenCheck, + 'confirm_password' => undef }, [ \&passSameCheck ] ); + return OK if( ! checkRegHash( $req, $tables, $data->{'email'}, $data->{'confirm'} ) );#Not much info, but this is an attack anyway + return genConfirmForm( $req, $args, $error, $data ) if( defined $error ); + unless( addUser( $tables, $data->{'login'}, $data->{'email'}, $data->{'password'} ) ) { + usedAddress( $req ); + return OK; + } + genHtmlHead( $req, 'Registered', undef ); + print '

Registered

+

+ You are now registered. + You can continue by logging in or continue anonymously.'; + genHtmlTail(); + return OK; +} + +sub genLoginForm( $$$$ ) { + my( $req, $args, $error, $values ) = @_; + $req->headers_out->add( 'Set-Cookie' => new CGI::Cookie( -name => 'cookie-test', -value => 1 ) ); + genHtmlHead( $req, 'Login', undef ); + print '

Login

'; + my $addr = PciIds::Address::new( $req->uri() ); + genCustomMenu( $addr, $args, [ [ 'Register', 'register' ], [ 'Reset password', 'respass' ] ] ); + print '

'.$error.'

' if( defined $error ); + print '
'; + genForm( [ [ 'Login name or email:', 'text', 'login', 'maxlength="255"' ], + [ 'Password:', 'password', 'password' ], + [ '', 'submit', 'login', 'value="Login"' ] ], $values ); + print '
'; + genHtmlTail(); + return OK; +} + +sub loginForm( $$$ ) { + my( $req, $args, $tables, $auth ) = @_; + return HTTPRedirect( $req, 'https://'.$req->hostname().$req->uri().buildArgs( $args ) ) unless( $auth->{'ssl'} ); + return genLoginForm( $req, $args, undef, {} ); +} + +sub loginSubmit( $$$ ) { + my( $req, $args, $tables ) = @_; + my( $data, $error ) = getForm( { + 'login' => undef, + 'password' => undef + }, [] ); + my $logged = 0; + my $cookies = fetch CGI::Cookie; + unless( $cookies->{'cookie-test'} ) { + return genLoginForm( $req, $args, 'You need to enable cookies', $data ); + } + my( $id, $passwd, $email, $last ) = $tables->getLogInfo( $data->{'login'} ); + if( defined $passwd && defined $data->{'password'} ) { + my $salted = saltedPasswd( $email, $data->{'password'} ); + $logged = $salted eq $passwd; + } + if( $logged ) { + $req->headers_out->add( 'Set-Cookie' => new CGI::Cookie( -name => 'auth', -value => genAuthToken( $tables, $id, $req, undef ) ) ); + $args->{'action'} = ( defined $args->{'redirectaction'} ) ? $args->{'redirectaction'} : 'list'; + my $prefix = ( !defined( $args->{'action'} ) or ( $args->{'action'} eq '' ) or ( $args->{'action'} eq 'list' ) ) ? 'read' : 'mods'; + my $url = "http://".$req->hostname().setAddrPrefix( $req->uri(), $prefix ).buildExcept( 'redirectaction', $args ); + genHtmlHead( $req, 'Logged in', undef ); + print '

Logged in

'; + print '

'.encode( $last ).'

' if( defined( $last ) ); + print "

Continue here"; + genHtmlTail(); + return OK; + } else { + return genLoginForm( $req, $args, 'Invalid login credetials', $data ); + } +} + +sub logout( $$ ) { + my( $req, $args, $tables, $auth ) = @_; + $req->headers_out->add( 'Set-Cookie' => new CGI::Cookie( -name => 'auth', -value => '0' ) ); + return PciIds::Html::List::list( $req, $args, $tables, {} ); +} + +sub checkLogin( $$ ) { + my( $req, $tables ) = @_; + my $cookies = fetch CGI::Cookie; + my( $authed, $id, $regen, $rights, $error ) = checkAuthToken( $tables, $req, defined( $cookies->{'auth'} ) ? $cookies->{'auth'}->value : undef ); + if( $regen ) { + $req->headers_out->add( 'Set-Cookie' => new CGI::Cookie( -name => 'auth', -value => genAuthToken( $tables, $id, $req, $rights ) ) ); + } + my $hterror = $authed ? '' : '

'.$error.'

'; + return { 'authid' => $authed ? $id : undef, 'accrights' => $rights, 'logerror' => $hterror }; +} + +sub notLoggedComplaint( $$$ ) { + my( $req, $args, $auth ) = @_; + return HTTPRedirect( $req, 'https://'.$req->hostname().$req->uri().buildArgs( $args ) ) unless $auth->{'ssl'}; + $args->{'redirectaction'} = $args->{'action'}; + return genLoginForm( $req, $args, 'This action requires you to be logged in', undef ); +} + +sub genResetPasswdForm( $$$$ ) { + my( $req, $args, $error, $values ) = @_; + genHtmlHead( $req, 'Reset password', undef ); + print "

Reset password

\n"; + print "

If you forgot your password (or didn't create one yet), you can reset it to a new value here.\n"; + print "Provide your email address here and further instructions will be sent to you.\n"; + print '

'.$error.'
' if( defined $error ); + print '
+ '; + genForm( [ [ 'Email:', 'text', 'email', 'maxlength="255"' ], + [ '', 'submit', 'respass', 'value="Send"' ] ], $values ); + print '
'; + genHtmlTail(); + return OK; +} + +sub resetPasswdForm( $$$$ ) { + my( $req, $args ) = @_; + return genResetPasswdForm( $req, $args, undef, {} ); +} + +sub resetPasswdFormSubmit( $$$ ) { + my( $req, $args, $tables ) = @_; + my( $data, $error ) = getForm( { + 'email' => undef + }, [] ); + my( $id, $login, $passwd ) = $tables->resetInfo( $data->{'email'} ); + if( defined( $id ) ) { + $login = '' unless( defined( $login ) ); + my $site = $req->hostname(); + my $url = 'https://'.$req->hostname().setAddrPrefix( $req->uri(), 'mods' ); + my $hash = genResetHash( $id, $data->{'email'}, $login, $passwd ); + sendMail( $data->{'email'}, 'Reset password', + "A request to reset password for the $site site was received for this address\n". + "If you really wish to get a new password, visit this link:\n\n". + $url.'?action=respass-confirm?email='.$data->{'email'}.'?confirm='.$hash."\n". + "\n\nThank you\n". + "\n(This is an autogenerated email, do not respond to it)" ); + genHtmlHead( $req, 'Reset password', undef ); + print "

Reset password

\n"; + print "

An email with information was sent to your address.\n"; + genHtmlTail(); + return OK; + } else { + $error = '

This email address is not registered. Check it for typos or register it.'; + } + return genResetPasswdForm( $req, $args, $error, $data ) if( defined( $error ) ); +} + +sub genResetPasswdConfigForm( $$$$$$ ) { + my( $req, $args, $error, $values, $email, $hash ) = @_; + genHtmlHead( $req, 'Reset password', undef ); + print "

Reset password

\n"; + print '
'.$error.'
' if( defined $error ); + print "

You can enter new password here:\n"; + print '

+ '; + genForm( [ [ 'Password:', 'password', 'password' ], + [ 'Confirm password:', 'password', 'confirm_password' ], + [ '', 'submit', 'respass', 'value="Send"' ] ], $values ); + print "
"; + print "\n"; + print "
\n"; + genHtmlTail(); + return OK; +} + +sub resetPasswdConfirmForm( $$$$ ) { + my( $req, $args, $tables, $auth ) = @_; + my( $email, $hash ) = ( $args->{'email'}, $args->{'confirm'} ); + my( $id, $login, $passwd ) = $tables->resetInfo( $email ); + my $myHash; + return HTTPRedirect( $req, 'https://'.$req->hostname().$req->uri().buildArgs( $args ) ) unless $auth->{'ssl'}; + $myHash = genResetHash( $id, $email, $login, $passwd ) if( defined( $id ) ); + if( defined( $myHash ) && ( $myHash eq $hash ) ) {#Ok, it is his mail and he asked + return genResetPasswdConfigForm( $req, $args, undef, {}, $email, $hash ); + } else { + genHtmlHead( $req, 'Reset password', undef ); + print "

Reset password

\n"; + print "

Provided link is not valid. Did you use it already?\n"; + print "

You can get a new one.\n"; + genHtmlTail(); + return OK; + } +} + +sub resetPasswdConfirmFormSubmit( $$$ ) { + my( $req, $args, $tables ) = @_; + my( $data, $error ) = getForm( { + 'password' => \&passLenCheck, + 'confirm_password' => undef, + 'email' => undef, + 'hash' => undef + }, [ \&passSameCheck ] ); + my( $email, $hash ) = ( $data->{'email'}, $args->{'confirm'} ); + if( defined( $error ) ) { + return genResetPasswdConfigForm( $req, $args, $error, $data, $email, $hash ); + } else { + my( $id, $login, $passwd ) = $tables->resetInfo( $email ); + my $myHash; + $myHash = genResetHash( $id, $email, $login, $passwd ) if( defined( $id ) ); + if( defined( $myHash ) && ( $myHash eq $hash ) ) { + changePasswd( $tables, $id, $data->{'password'}, $email ); + genHtmlHead( $req, 'Reset password', undef ); + print "

Reset password

\n"; + print "

Your password was successfuly changed. You can log in.\n"; + genHtmlTail(); + return OK; + } else { + return genResetPasswdConfigForm( $req, $args, $error, $data, $email, $hash ); + } + } +} + +sub genProfileForm( $$$$$ ) { + my( $req, $args, $error, $data, $info ) = @_; + genHtmlHead( $req, 'User profile', undef ); + delete $data->{'current_password'}; + delete $data->{'confirm_password'}; + delete $data->{'password'}; + print "

User profile

\n"; + print '

'.$error.'

' if defined $error; + print "

$info

\n" if defined $info; + print '
'; + genForm( [ [ 'Email:', 'text', 'email', 'maxlength="255"' ], + [ 'Login:', 'text', 'login', 'maxlength="50"' ], + [ 'Xmpp:', 'text', 'xmpp', 'maxlength="255"' ], + [ 'New password:', 'password', 'password' ], + [ 'Confirm password:', 'password', 'confirm_password' ], + [ 'Current password:', 'password', 'current_password' ], + [ 'Email batch time (min):', 'text', 'email_time', 'maxlength="10"' ], + [ 'Xmpp batch time (min):', 'text', 'xmpp_time', 'maxlength="10"' ], + [ '', 'submit', 'profile', 'value="Submit"' ] ], $data ); + print '
'; + print "

Back to browsing\n"; + genHtmlTail(); + return OK; +} + +sub profileForm( $$$$ ) { + my( $req, $args, $tables, $auth ) = @_; + return notLoggedComplaint( $req, $args, $auth ) unless defined $auth->{'authid'}; + return HTTPRedirect( $req, 'https://'.$req->hostname().$req->uri().buildArgs( $args ) ) unless $auth->{'ssl'}; + return genProfileForm( $req, $args, undef, $tables->profileData( $auth->{'authid'} ), undef ); +} + +sub checkNum( $$ ) { + my( $value, $name ) = @_; + return ( "$name has invalid number format", '0' ) unless ( $value =~ /\d+/ ); + return undef; +} + +sub profileFormSubmit( $$$$ ) { + my( $req, $args, $tables, $auth ) = @_; + return notLoggedComplaint( $req, $args, $auth ) unless defined $auth->{'authid'}; + my $oldData = $tables->profileData( $auth->{'authid'} ); + my( $data, $error ) = getForm( { + 'email' => sub { + my $email = shift; + return undef if ( defined $email ) && ( $email eq $oldData->{'email'} ); + return emailCheck( $email, $tables ); + }, + 'login' => sub { + my $login = shift; + $login = undef if ( defined $login ) && ( $login eq '' ); + return undef if ( defined $login ) && ( defined $oldData->{'login'} ) && ( $oldData->{'login'} eq $login ); + return ( undef, $login ) if ( !defined $login ) && ( !defined $oldData->{'login'} ); + return loginCheck( $login, $tables ); + }, + 'xmpp' => sub { + my $xmpp = shift; + return ( undef, undef ) if ( !defined $xmpp ) || ( $xmpp eq '' ); + return "Xmpp address limit is 255" if length $xmpp > 255; + return "Invalid Xmpp address" unless $xmpp =~ /^([^'"\@<>\/]+\@)?[^\@'"<>\/]+(\/.*)?/; + return undef; + }, + 'password' => sub { + my $passwd = shift; + $passwd = undef if ( defined $passwd ) && ( $passwd eq '' ); + return ( undef, undef ) unless defined $passwd; + return passLenCheck( $passwd ); + }, + 'confirm_password' => undef, + 'current_password' => undef, + 'email_time' => sub { + return checkNum( shift, "Email batch time" ); + }, + 'xmpp_time' => sub { + return checkNum( shift, "Xmpp batch time" ); + } + }, [ sub { + my $data = shift; + return undef unless defined $data->{'password'}; + return passSameCheck( $data ); + }, sub { + my $data = shift; + my $change = 0; + $change = 1 if $data->{'email'} ne $oldData->{'email'}; + $change = 1 if ( ( ( defined $data->{'login'} ) != ( defined $oldData->{'login'} ) ) || ( ( defined $data->{'login'} ) && ( defined $oldData->{'login'} ) && ( $data->{'login'} ne $oldData->{'login'} ) ) ); + $change = 1 if ( defined $data->{'password'} ) && ( $data->{'password'} ne '' ); + return undef unless $change; + my $logged = 0; + my( $id, $passwd, $email, $last ) = $tables->getLogInfo( $oldData->{'email'} ); + if( defined $passwd && defined $data->{'current_password'} ) { + my $salted = saltedPasswd( $email, $data->{'current_password'} ); + $logged = ( $salted eq $passwd ) && ( $id == $auth->{'authid'} ); + } + return "You need to provide correct current password to change email, login or password" unless $logged; + return undef; + } ] ); + return genProfileForm( $req, $args, $error, $data, undef ) if defined $error; + pushProfile( $tables, $auth->{'authid'}, $oldData, $data ); + return genProfileForm( $req, $args, undef, $data, "Profile updated." ); +} + +1; diff --git a/internet/impl/PciIds/Html/Util.pm b/internet/impl/PciIds/Html/Util.pm new file mode 100644 index 0000000..1bda66d --- /dev/null +++ b/internet/impl/PciIds/Html/Util.pm @@ -0,0 +1,120 @@ +package PciIds::Html::Util; +use strict; +use warnings; +use HTML::Entities; +use base 'Exporter'; +use PciIds::Users; +use Apache2::Const qw(:common :http); +use APR::Table; + +our @EXPORT = qw(&genHtmlHead &htmlDiv &genHtmlTail &genTableHead &genTableTail &parseArgs &buildExcept &buildArgs &genMenu &genCustomMenu &encode &setAddrPrefix &HTTPRedirect); + +sub encode( $ ) { + return encode_entities( shift, "\"'&<>" ); +} + +sub genHtmlHead( $$$ ) { + my( $req, $caption, $metas ) = @_; + $req->content_type( 'text/html; charset=utf-8' ); + $req->headers_out->add( 'Cache-control' => 'no-cache' ); + print ''."\n"; + print ''.encode( $caption )."\n"; + print "\n"; + print "\n"; + print $metas if( defined( $metas ) ); + print "\n"; +} + +sub genHtmlTail() { + print ''; +} + +sub htmlDiv( $$ ) { + my( $class, $text ) = @_; + return '

'.$text.'
'; +} + +sub item( $$$ ) { + my( $url, $label, $action ) = @_; + print "
  • $label\n"; +} + +sub genCustomMenu( $$$ ) { + my( $address, $args, $list ) = @_; + my $url = '/'.$address->get().buildExcept( 'action', $args ).'?action='; + print "
    \n
      \n"; + foreach( @{$list} ) { + my( $label, $action ) = @{$_}; + my $prefix = '/mods'; + $prefix = '/read' if( !defined( $action ) or ( $action eq 'list' ) or ( $action eq '' ) ); + item( $prefix.$url, $label, $action ); + } + print "
    \n"; +} + +sub genMenu( $$$ ) { + my( $address, $args, $auth ) = @_; + my @list; + if( defined( $auth->{'authid'} ) ) { + push @list, [ 'Log out', 'logout' ]; + } else { + push @list, [ 'Log in', 'login' ]; + } + push @list, [ 'Add item', 'newitem' ] if( $address->canAddItem() ); + push @list, [ 'Discuss', 'newcomment' ] if( $address->canAddComment() ); + push @list, [ 'Administrate', 'admin' ] if( hasRight( $auth->{'accrights'}, 'validate' ) ); + push @list, [ 'Profile', 'profile' ] if defined $auth->{'authid'}; + push @list, [ 'Notifications', 'notifications' ] if defined $auth->{'authid'}; + genCustomMenu( $address, $args, \@list ); +} + +sub genTableHead( $$ ) { + my( $class, $captions ) = @_; + print ''; + foreach( @{$captions} ) { + print ''; +} + +sub genTableTail() { + print '
    '.$_; + } + print '
    '; +} + +sub parseArgs( $ ) { + my %result; + foreach( split /\?/, shift ) { + next unless( /=/ ); + my( $name, $value ) = /^([^=]+)=(.*)$/; + $result{$name} = $value; + } + return \%result; +} + +sub buildArgs( $ ) { + my( $args ) = @_; + my $result = ''; + $result .= "?$_=".$args->{$_} foreach( keys %{$args} ); + return $result; +} + +sub buildExcept( $$ ) { + my( $except, $args ) = @_; + my %backup = %{$args}; + delete $backup{$except}; + return buildArgs( \%backup ); +} + +sub setAddrPrefix( $$ ) { + my( $addr, $prefix ) = @_; + $addr =~ s/\/(mods|read|static)//; + return "/$prefix$addr"; +} + +sub HTTPRedirect( $$ ) { + my( $req, $link ) = @_; + $req->headers_out->add( 'Location' => $link ); + return HTTP_SEE_OTHER; +} + +1; diff --git a/internet/impl/PciIds/Log.pm b/internet/impl/PciIds/Log.pm new file mode 100644 index 0000000..3f0a8e3 --- /dev/null +++ b/internet/impl/PciIds/Log.pm @@ -0,0 +1,36 @@ +package PciIds::Log; +use strict; +use warnings; +use base 'Exporter'; +use PciIds::Config; + +our @EXPORT = qw(&flog &tlog &logEscape &tulog); + +checkConf( [ 'logfile' ] ); + +sub flog( $ ) { + my( $text ) = @_; + open LOG, '>>'.$config{'logfile'} or die "Could not open log file\n"; + print LOG "$text\n"; + close LOG; +} + +sub tlog( $ ) { + my( $text ) = @_; + my $time = time; + flog( "$time: $text" ); +} + +sub tulog( $$ ) { + my( $user, $text ) = @_; + tlog( "User $user: $text" ); +} + +sub logEscape( $ ) { + my( $text ) = @_; + return "''" unless defined $text; + $text =~ s/(['"\\])/\\$1/g; + return "'$text'"; +} + +1; diff --git a/internet/impl/PciIds/Notifications.pm b/internet/impl/PciIds/Notifications.pm new file mode 100644 index 0000000..a0e52b5 --- /dev/null +++ b/internet/impl/PciIds/Notifications.pm @@ -0,0 +1,82 @@ +package PciIds::Notifications; +use strict; +use warnings; +use PciIds::Address; +use PciIds::Config; +use PciIds::Email; +use PciIds::Xmpp; +use base 'Exporter'; + +our @EXPORT = qw(¬ify &sendNotifs &flushNotifs); + +sub notify( $$$$$ ) { + my( $tables, $location, $comment, $priority, $reason ) = @_; + $tables->pushNotifications( $location, $comment, $priority, $reason ); +} + +sub sendNotif( $$$ ) { + my( $address, $message, $sendFun ) = @_; + return unless defined $address; + &{$sendFun}( + $address, + "Item change notifications for $config{hostname}", + "$message\nThis is automatic notification message, do not respond to it.\nYou can change your notifications at http://$config{hostname}/mods/PC/?action=notifications\n" ); +} + +sub sendOut( $$ ) { + my( $notifs, $sendFun ) = @_; + my( $last_address, $last_user ); + my $message = ''; + foreach( @{$notifs} ) { + my( $user, $address, $reason, $text, $newname, $newdesc, $time, $author, $location, $name, $desc ) = @{$_}; + if( ( !defined $last_user ) || ( $last_user != $user ) ) { + sendNotif( $last_address, $message, $sendFun ); + $last_address = $address; + $last_user = $user; + $message = ''; + } + my $note; + my $addr = PciIds::Address::new( $location ); + if( $reason == 0 ) { + $note = "New item was created.\n Id: ".$addr->pretty()."\n Name: $newname\n"; + $note .= " Description: $newdesc\n" if( defined $newdesc && ( $newdesc ne '' ) ); + $note .= " Comment text: $text\n" if( defined $text && ( $text ne '' ) ); + $note .= " Author: $author\n" if( defined $author && ( $author ne '' ) ); + $note .= " Time: $time\n"; + $note .= " Address: http://".$config{'hostname'}."/read/".$addr->get()."\n"; + } elsif( $reason == 1 ) { + $note = "New comment created.\n Item:\n"; + $note .= " Id: ".$addr->pretty()."\n"; + $note .= " Name: $name\n" if( defined $name && ( $name ne '' ) && ( $name ne $newname ) ); + $note .= " Description: $desc\n" if( defined $desc && ( $desc ne '' ) && ( $desc ne $newdesc ) ); + $note .= " Address: http://".$config{'hostname'}."/read/".$addr->get()."\n"; + $note .= " Comment:\n"; + $note .= " Proposed name: $newname\n" if( defined $newname && ( $newname ne '' ) ); + $note .= " Proposed description: $newdesc\n" if( defined $newdesc && ( $newdesc ne '' ) ); + $note .= " Text: $text\n" if( defined $text && ( $text ne '' ) ); + $note .= " Author: $author\n" if( defined $author && ( $author ne '' ) ); + $note .= " Time: $time\n"; + } elsif( $reason == 2 ) { + $note = "Item name validated.\n Id:".$addr->pretty()."\n"; + $note .= " Name: $newname\n"; + $note .= " Description: $newdesc\n" if( defined $newdesc && ( $newdesc ne '' ) ); + $note .= " Comment text: $text\n" if( defined $text && ( $text ne '' ) ); + $note .= " Address: http://".$config{'hostname'}."/read/".$addr->get()."\n"; + } + $message .= "\n" unless $message eq ''; + $message .= $note; + } + sendNotif( $last_address, $message, $sendFun ); +} + +sub sendNotifs( $ ) { + my( $tables ) = @_; + my $time = $tables->time(); + sendOut( $tables->mailNotifs( $time ), \&PciIds::Email::sendMail ); + sendOut( $tables->xmppNotifs( $time ), \&PciIds::Xmpp::sendXmpp ); + $tables->dropNotifs( $time ); +} + +checkConf( [ 'hostname' ] ); + +1; diff --git a/internet/impl/PciIds/Users.pm b/internet/impl/PciIds/Users.pm new file mode 100644 index 0000000..d437f9c --- /dev/null +++ b/internet/impl/PciIds/Users.pm @@ -0,0 +1,129 @@ +package PciIds::Users; +use strict; +use warnings; +use base 'Exporter'; +use PciIds::Db; +use DBI; +use PciIds::Config; +use Digest::MD5 qw(md5_base64 md5_hex);#TODO Some better algorithm? +use HTML::Entities; +use Startup; +use PciIds::Log; +use Apache2::Connection; + +my( %privnames, %privnums ); + +our @EXPORT = qw(&addUser &emailConfirm &checkConfirmHash &saltedPasswd &genAuthToken &checkAuthToken &hasRight &getRightDefs &genResetHash &changePasswd &pushProfile); + +sub saltedPasswd( $$ ) { + my( $email, $passwd ) = @_; + my $salt = $config{'passwdsalt'}; + return md5_base64( "$email:$passwd:$salt" ); +} + +sub genResetHash( $$$$ ) { + my( $id, $email, $login, $passwd ) = @_; + my $salt = $config{'regmailsalt'}; + return md5_hex( "$id:$email:$login:$passwd:$salt" ); +} + +sub emailConfirm( $ ) { + my( $email ) = @_; + my $salt = $config{'regmailsalt'}; + return md5_hex( $email.$salt ); +} + +sub checkConfirmHash( $$ ) { + my( $email, $hash ) = @_; + return 0 unless( ( defined $email ) && ( defined $hash ) ); + my( $expected ) = emailConfirm( $email ); + return ( $expected eq $hash ); +} + +sub addUser( $$$$ ) { + my( $tables, $name, $email, $passwd ) = @_; + my $salted = saltedPasswd( $email, $passwd ); + tlog( "Creating user $email" . ( ( defined $name ) ? " - $name" : '' ) ); + my $id = $tables->addUser( $name, $email, $salted ); + tlog( "User ($email) id: $id" ); + return $id; +} + +sub changePasswd( $$$$ ) { + my( $tables, $id, $passwd, $email ) = @_; + my $salted = saltedPasswd( $email, $passwd ); + $tables->changePasswd( $id, $salted ); +} + +sub genAuthToken( $$$$ ) { + my( $tables, $id, $req, $rights ) = @_; + unless( defined $rights ) {#Just logged in + my $from = $req->connection()->remote_ip(); + $tables->setLastLog( $id, $from ); + $rights = $tables->rights( $id ); + } + my $haveRights = scalar @{$rights}; + my $time = time; + my $ip = $req->connection()->remote_ip(); + return "$id:$haveRights:$time:".md5_hex( "$id:$time:$ip:".$config{'authsalt'} ); +} + +sub checkAuthToken( $$$ ) { + my( $tables, $req, $token ) = @_; + my( $id, $haveRights, $time, $hex ) = defined( $token ) ? split( /:/, $token ) : (); + return ( 0, 0, 0, [], "Not logged in" ) unless( defined $hex ); + my $ip = $req->connection()->remote_ip(); + my $expected = md5_hex( "$id:$time:$ip:".$config{'authsalt'} ); + my $actTime = time; + my $tokOk = ( $expected eq $hex ); + my $authed = ( $tokOk && ( $time + $config{'authtime'} > $actTime ) ); + my $regen = $authed && ( $time + $config{'regenauthtime'} < $actTime ); + my $rights = []; + if( $haveRights ) { + foreach( @{$tables->rights( $id )} ) { + my %r; + ( $r{'id'} ) = @{$_}; + $r{'name'} = $privnames{$r{'id'}}; + push @{$rights}, \%r; + } + } + return ( $authed, $id, $regen, $rights, $authed ? undef : ( $tokOk ? "Login timed out" : "Not logged in x" ) ); +} + +sub hasRight( $$ ) { + my( $rights, $name ) = @_; + foreach( @{$rights} ) { + return 1 if( $_->{'name'} eq $name ); + } + return 0; +} + +sub getRightDefs() { + return ( \%privnums, \%privnames ); +} + +sub pushProfile( $$$$ ) { + my( $tables, $id, $oldData, $data ) = @_; + my( $email, $passwd ) = ( $data->{'email'}, $data->{'current_password'} ); + if( ( defined $passwd ) && ( $passwd ne '' ) ) { + my $salted = saltedPasswd( $email, $passwd ); + $tables->setEmail( $id, $email, $salted ); + } + $data->{'login'} = undef if ( defined $data->{'login'} ) && ( $data->{'login'} eq '' ); + $data->{'xmpp'} = undef if ( defined $data->{'xmpp'} ) && ( $data->{'xmpp'} eq '' ); + $tables->pushProfile( $id, $data->{'login'}, $data->{'xmpp'}, $data->{'email_time'}, $data->{'xmpp_time'} ); + changePasswd( $tables, $id, $data->{'password'}, $email ) if ( defined $data->{'password'} ) && ( $data->{'password'} ne '' ); +} + +checkConf( [ 'passwdsalt', 'regmailsalt', 'authsalt' ] ); +defConf( { 'authtime' => 2100, 'regenauthtime' => 300 } ); + +open PRIVS, $directory."/rights" or die "Could not open privilege definitions\n"; +foreach( ) { + my( $num, $name ) = /^(\d+)\s+(.*)$/ or die "Invalid syntax in privileges\n"; + $privnames{$num} = $name; + $privnums{$name} = $num; +} +close PRIVS; + +1; diff --git a/internet/impl/PciIds/Xmpp.pm b/internet/impl/PciIds/Xmpp.pm new file mode 100644 index 0000000..ba444b0 --- /dev/null +++ b/internet/impl/PciIds/Xmpp.pm @@ -0,0 +1,34 @@ +package PciIds::Xmpp; +use strict; +use warnings; +use PciIds::Config; +use base 'Exporter'; + +our @EXPORT = qw(&sendXmpp &flushXmpp); + +my @pending; + +sub sendXmpp( $$$ ) { + my( $to, $subject, $body ) = @_; + push @pending, [ $to, $subject, $body ]; +} + +sub flushXmpp() { + return unless @pending; + open JELNET, "|$config{xmpp_pipe} > /dev/null" or die "Could not start XMPP sender\n"; + foreach( @pending ) { + my( $to, $subject, $body ) = @{$_}; + $subject =~ s/&/&/g; + $subject =~ s/'/'/g; + $subject =~ s/"/"/g; + $body =~ s/&/&/g; + $body =~ s//>/g; + print JELNET "$subject$body"; + } + close JELNET; +} + +checkConf( [ "xmpp_pipe" ] ); + +1; diff --git a/internet/impl/Startup.pm b/internet/impl/Startup.pm new file mode 100644 index 0000000..7b8fca6 --- /dev/null +++ b/internet/impl/Startup.pm @@ -0,0 +1,13 @@ +package Startup; +use strict; +use warnings; +use base 'Exporter'; + +#Where are data? +our $directory = '/home/vorner/skola/cvika/internet/impl'; +our @EXPORT=qw($directory); + +#Where are the modules? +use lib ( '/home/vorner/skola/cvika/internet/impl' ); + +1; diff --git a/internet/impl/config b/internet/impl/config new file mode 100644 index 0000000..9d80c17 --- /dev/null +++ b/internet/impl/config @@ -0,0 +1,11 @@ +db = pciids +dbuser = pciids +dbpasswd = 1234 +passwdsalt = 1234 +regmailsalt = 1234 +authsalt = 1234 +from_addr = vorner+pciids@ucw.cz +sendmail = /home/vorner/bin/sendmail-apache +logfile = /home/vorner/skola/cvika/internet/impl/pciids.log +hostname = localhost +xmpp_pipe = /home/vorner/bin/xmpp_pipe diff --git a/internet/impl/notes b/internet/impl/notes new file mode 100644 index 0000000..7b8405e --- /dev/null +++ b/internet/impl/notes @@ -0,0 +1,10 @@ +• Can use mod_perl? + +• Deleting users + - Allow deleting? + - What to do with history, when user deleted? + +• Importing data + - What to do, when it changes a name/comment? + . if it has main article + . if it doesn't have main article diff --git a/internet/impl/rights b/internet/impl/rights new file mode 100644 index 0000000..cd7fd40 --- /dev/null +++ b/internet/impl/rights @@ -0,0 +1,2 @@ +1 validate +2 listUsers diff --git a/internet/impl/scripts/cleardb.pl b/internet/impl/scripts/cleardb.pl new file mode 100755 index 0000000..03455d3 --- /dev/null +++ b/internet/impl/scripts/cleardb.pl @@ -0,0 +1,15 @@ +#!/usr/bin/perl + +use strict; +use warnings; +BEGIN { + unshift @INC, "."; +} +use PciIds::Db; +use DBI; + +my $dbh = connectDb(); +$dbh->prepare( 'DELETE FROM locations' )->execute(); +$dbh->prepare( 'DELETE FROM history' )->execute(); +$dbh->commit(); +$dbh->disconnect(); diff --git a/internet/impl/scripts/export.pl b/internet/impl/scripts/export.pl new file mode 100755 index 0000000..9aafa20 --- /dev/null +++ b/internet/impl/scripts/export.pl @@ -0,0 +1,32 @@ +#!/usr/bin/perl + +use strict; +use warnings; +BEGIN { + unshift @INC, "."; +} +use PciIds::Db; +use PciIds::DBQAny; + +my $db = PciIds::DBQAny::new( connectDb(), { + 'list' => 'SELECT id, name, description FROM locations WHERE name IS NOT NULL ORDER BY id' +} ); + +foreach( @{$db->query( 'list', [] )} ) { + my( $id, $name, $description ) = @{$_}; + $_ = $id; + my $prefix = ( /^PC/ ) ? '' : 'C '; + s/^P.\///; + s/[^\/]//g; + s/\//\t/g; + my $tabs = $_; + $id =~ s/.*\///; + print "$tabs$prefix$id $name\n"; + if( defined( $description ) && ( $description ne '' ) ) { + chomp $description; + $description =~ s/\n/\n$tabs#/g; + print "$tabs#$description\n"; + } +} + +$db->commit(); diff --git a/internet/impl/scripts/feeddb.pl b/internet/impl/scripts/feeddb.pl new file mode 100755 index 0000000..e3a71ca --- /dev/null +++ b/internet/impl/scripts/feeddb.pl @@ -0,0 +1,63 @@ +#!/usr/bin/perl + +use strict; +use warnings; +BEGIN { + unshift @INC, "."; +} +use PciIds::Db; +use DBI; + +my $dbh = connectDb(); +my $query = $dbh->prepare( "INSERT INTO locations (id, name, description, parent) VALUES(?, ?, ?, ?);" ) or die "Could not create the query (".DBI->errstr.")\n"; +my $comment = $dbh->prepare( "INSERT INTO history (location, nodename, nodedescription, seen) VALUES(?, ?, ?, '1')" ) or die "Could not create query (".DBI->errstr.")\n"; +my $update = $dbh->prepare( "UPDATE locations SET maincomment = ? WHERE id = ?" ) or die "Could not create query (".DBI->errstr.")\n"; +my( $vendor, $type, $sub, $description, $name ); + +$query->execute( "PC", undef, undef, undef ) or die "Could not add toplevel node\n"; +$query->execute( "PD", undef, undef, undef ) or die "Could not add toplevel node\n"; + +sub submit( $ ) { + my( $id ) = @_; + my $parent = $id; + $parent =~ s/\/[^\/]+$//; + $query->execute( $id, $name, $description, $parent ); + $comment->execute( $id, $name, $description ); + my $com = $dbh->last_insert_id( undef, undef, undef, undef ); + $update->execute( $com, $id ); + undef $description; +} + +print "Filling database from id file\n"; + +foreach( <> ) { + chomp; + if( s/^\s*#\s*// ) { + $description = $_; + } elsif( /^\s*$/ ) { + undef $description; + } elsif( /^\t\t/ ) { + if( $vendor =~ /^PC/ ) { + ( $sub, $name ) = /^\s*([0-9a-fA-F]+\s[0-9a-fA-F]+)\s+(.*)$/; + $sub =~ s/\s+//g; + } else { + ( $sub, $name ) = /^\s*([0-9a-fA-F]+)\s+(.*)$/; + } + submit( $vendor.'/'.$type.'/'.$sub ); + } elsif( /^\t/ ) { + ( $type, $name ) = /^\s*([0-9a-fA-F]+)\s+(.*)$/; + submit( $vendor.'/'.$type ); + } elsif( /^C\s/ ) { + ( $vendor, $name ) = /^C\s+([0-9a-fA-F]+)\s+(.*)$/; + $vendor = 'PD/'.$vendor; + submit( $vendor ); + } elsif( /^[0-9a-fA-F]/ ) { + ( $vendor, $name ) = /([0-9a-fA-F]+)\s+(.*)$/; + $vendor = 'PC/'.$vendor; + submit( $vendor ); + } else { + die "Um what?? $_\n"; + } +} +$dbh->commit(); +$dbh->disconnect; diff --git a/internet/impl/scripts/importlog.pl b/internet/impl/scripts/importlog.pl new file mode 100755 index 0000000..df75d92 --- /dev/null +++ b/internet/impl/scripts/importlog.pl @@ -0,0 +1,86 @@ +#!/usr/bin/perl +use strict; +BEGIN { + unshift @INC, "."; +}; +use PciIds::Db; + +my %tracked; + +sub translateLoc( $ ) { + my $loc = shift; + $loc =~ s/(.{8})(.+)/$1\/$2/; + $loc =~ s/(.{4})(.+)/$1\/$2/; + return "PC/$loc"; +} + +my $dbh = connectDb(); +my $clearHist = $dbh->prepare( 'DELETE FROM history WHERE location = ?' ); +my %coms; +my $com = $dbh->prepare( 'INSERT INTO history (owner, location, time, nodename, nodedescription) VALUES (?, ?, FROM_UNIXTIME(?), ?, ?)' ); +my $user = $dbh->prepare( 'SELECT id FROM users WHERE email = ?' ); +my $delHis = $dbh->prepare( 'DELETE FROM history WHERE id = ?' ); +my $markMain = $dbh->prepare( 'UPDATE locations SET + maincomment = ?, + name = ( SELECT nodename FROM history WHERE id = ? ), + description = ( SELECT nodedescription FROM history WHERE id = ? ) + WHERE + id = ?' ); +my $markSeen = $dbh->prepare( "UPDATE history SET seen = '1' WHERE id = ?" ); + +sub getUser( $ ) { + $user->execute( shift ); + if( my( $id ) = $user->fetchrow_array ) { + return $id; + } else { + return undef; + } +} + +my $accept = 0; +my $reject = 0; +my $del = 0; +my $appr = 0; + +print "Parsing and importing log\n"; + +foreach( <> ) { + my( $time, $who, $ip, $command, $id, $location, $name, $description, $email ); + if( ( $time, $who, $ip, $command, $id, $location, $name, $description, $email ) = /^(\d+) (\S+) ([0-9.]+) (Create|Batch submit:) (\d+) ([0-9a-f]+) '(.*)(?execute( $translated ); + } + $name =~ s/\\(.)/$1/g; + $description =~ s/\\(.)/$1/g; + $name = undef if( $name eq '' ); + $description = undef if( $description eq '' ); + eval {#If the item is not here at all, it was deleted -> no need to add it here + $com->execute( getUser( $email ), $translated, $time, $name, $description ); + $coms{$id} = $dbh->last_insert_id( undef, undef, undef, undef ); + $accept ++; + }; + if( $@ ) { + $reject ++; + } + } elsif( ( $time, $who, $ip, $command, $id, $location, $description, $email ) = /^(\d+) (\S+) ([0-9.]+) (Approve|Delete|Overriden) (\d+) ([0-9a-f]+) '(.*)(?execute( $i, $i, $i, translateLoc( $location ) ); + $markSeen->execute( $i ); + $appr ++; + } elsif( $command eq 'Delete' ) { + $delHis->execute( $coms{$id} ); + $del ++; + } else { + $markSeen->execute( $coms{$id} ); + } + } else { + print "Unparsed line: $_"; + } +} + +$dbh->commit(); +$dbh->disconnect(); diff --git a/internet/impl/scripts/init b/internet/impl/scripts/init new file mode 100755 index 0000000..30cc1a9 --- /dev/null +++ b/internet/impl/scripts/init @@ -0,0 +1,6 @@ +./scripts/initdb.pl +./scripts/feeddb.pl pci.ids +./scripts/transfer.pl pciidsold +./scripts/importlog.pl iii.log +echo 'Database is prepared, but it does not contain admins. Add them manually, please.' +echo 'Just register like ordinary user and run ./scripts/rights.pl + username validate' diff --git a/internet/impl/scripts/initdb.pl b/internet/impl/scripts/initdb.pl new file mode 100755 index 0000000..e80f719 --- /dev/null +++ b/internet/impl/scripts/initdb.pl @@ -0,0 +1,47 @@ +#!/usr/bin/perl + +use strict; +use warnings; +BEGIN { + unshift @INC, "."; +} +use PciIds::Config; +use PciIds::Db; +use DBI; + +my @lines; +my $tablename; + +defConf( { "dbcharset" => "UTF8", "dbtype" => "InnoDB" } ); + +my %replaces = ( + "CHARSET" => "CHARSET ".$config{"dbcharset"} +); + +sub createTable( $ ) { + die "Invalid table definition\n" unless( defined( $tablename ) && @lines ); + my $nt = $_[ 0 ]->prepare( "CREATE TABLE ".$tablename." (".( join "\n", @lines ).") TYPE = $config{dbtype};" ); + $nt->execute(); + @lines = (); + print "Created table $tablename\n"; + undef $tablename; +} + +my $dbh = connectDb(); +open TABLES, "tables" or die "Could not open table definitions\n"; +foreach( ) { + chomp; + if( /^\s*$/ ) { + createTable( $dbh ); + } elsif( s/^@// ) { + $tablename = $_; + } else { + s/#.*//; + s/<<([^<>]+)>>/$replaces{$1}/g; + push @lines, $_; + } +} +close TABLES; +createTable( $dbh ); +$dbh->commit(); +$dbh->disconnect; diff --git a/internet/impl/scripts/mailbot b/internet/impl/scripts/mailbot new file mode 100755 index 0000000..e8a4a3b --- /dev/null +++ b/internet/impl/scripts/mailbot @@ -0,0 +1,296 @@ +#!/usr/bin/perl +# Mail robot for processing of PCI ID submissions +# (c) 2001--2002 Martin Mares +# 2008 Michal Vaner + +use Mail::Header; +use Getopt::Long; +use IO::Handle; +BEGIN { + unshift @INC, "."; +} +use PciIds::Db; +use PciIds::Log; +use PciIds::Notifications; +use PciIds::DBQ; + +my $patch = 0; +my $emulate = 0; +my $debug = 0; +my $original = ""; +my $author = ""; +GetOptions( + 'patch!' => \$patch, + 'emulate!' => \$emulate, + 'debug!' => \$debug, + 'orig=s' => \$original, + 'author=s' => \$author +) || die "Usage: mailbot [--patch] [--emulate] [--debug] [--orig ] [--author ]"; + +my $reply = ""; +my $reply_plain = ""; +my $msgid = ""; +my $subject = ""; +my $tables = PciIds::DBQ::new( connectDb() ); + +my $hasAuth = $tables->dbh()->prepare( 'SELECT id FROM users WHERE email = ?' ); +my $addAuth = $tables->dbh()->prepare( "INSERT INTO users (email, passwd) VALUES(?, '')" ); +my $hasItem = $tables->dbh()->prepare( "SELECT 1 FROM locations WHERE id = ?" ); +my $addItem = $tables->dbh()->prepare( "INSERT INTO locations (id, parent) VALUES (?, ?)" ); +my $addComment = $tables->dbh()->prepare( "INSERT INTO history (owner, location, text, nodename, nodedescription) VALUES (?, ?, ?, ?, ?)" ); + +sub getAuthor( $ ) { + my( $mail ) = @_; + $hasAuth->execute( $mail ); + if( my( $id ) = $hasAuth->fetchrow_array ) { + return $id; + } else { + tlog( "mailbot: Creating user $mail" ); + $addAuth->execute( $mail ); + my $nid = $dbh->last_insert_id( undef, undef, undef, undef ); + tlog( "mailbot: User ($mail) id: $nid" ); + return $nid; + } +} + +sub submitItem( $$$$$ ) { + my( $id, $name, $description, $text, $author ) = @_; + my $created; + $id =~ s/(.{8})(.*)/$1\\$2/; + $id =~ s/(.{4})(.*)/$1\\$2/; + $id = "PC/$id"; + $hasItem->execute( $id ); + unless( $hasItem->fetchrow_array ) { + tlog( "mailbot: Item created (empty) $id" ); + my $parent = $id; + $parent =~ s/\/[^\/]*//; + $addItem->execute( $id, $parent ); + $created = 1; + } + $addComment->execute( $author, $id, $text, $name, $description ); + my $hid = $tables->last(); + tlog( "mailbot: Comment created $hid $id ".logEscape( $name )." ".logEscape( $description )." ".logEscape( $text ) ); + notify( $tables, $id, $hid, $created ? 2 : 1, $created ? 0 : 1 ); +} + +if (!$patch) { + $hdr = new Mail::Header; + $hdr->modify(1); + $hdr->mail_from(COERCE); + $hdr->read(*STDIN{IO}); + $hdr->unfold(); + $mfrom = $hdr->get('Mail-From'); + chomp $mfrom; + ($mfrom =~ /^MAILER-DAEMON@/i) && blackhole("From mailer daemon"); + $mfrom =~ s/ .*// or blackhole("Malformed envelope sender"); + ($reply = $hdr->get('Reply-To')) || ($reply = $hdr->get('From')) || + blackhole("Don't know who should I reply to"); + chomp $reply; + if ($reply =~ /<(\S*)>/) { + $reply_plain = $1; + } elsif ($reply =~ /^\S+$/) { + $reply_plain = $reply; + } else { + $reply_plain = $mfrom; + } + $reply_plain =~ tr/\n'"\\//d; + $msgid = $hdr->get('Message-Id'); + chomp $msgid; + my $subj = $hdr->get('Subject'); + chomp $subj; + if ($subj =~ /^IDS: (.*)/) { + $subject = $1; + } + $author = $reply_plain; +} + +$tprefix = "tmp/mbot-$$"; +$home = "../.."; +mkdir("tmp", 0777); +mkdir($tprefix, 0777) || error("Cannot create tmpdir"); +chdir($tprefix) || error("Cannot chdir to tmpdir"); + +open(TEMP, ">patch") || error("Cannot create tmpfile"); +if ($debug || $reply eq "") { + open(LOG, ">&STDOUT") || error ("Cannot create outfile"); +} else { + open(LOG, ">log") || error ("Cannot create outfile"); + LOG->autoflush(1); +} +if ($reply) { + print LOG "Got mail from $reply, will reply to $reply_plain.\n"; + print LOG "Scanning mail for patch.\n"; +} else { + print LOG "Scanning STDIN for patch.\n"; +} +while () { + while (/^--- /) { + $l0 = $_; + $_ = ; + if (/^\+\+\+ /) { + print TEMP $l0; + print TEMP $_; + while (1) { + $_ = ; + chomp; + if (/^\s*$/ || !/^[ +\@-]/) { + close TEMP; + process(); + exit 0; + } + print TEMP "$_\n"; + /^@@ -\d+,(\d+) \+\d+,(\d+) @@/ || error("Malformed patch"); + $old = $1; + $new = $2; + while ($old || $new) { + $_ = ; + print TEMP $_; + if (/^ /) { $old--; $new--; } + elsif (/^-/) { $old--; } + elsif (/^\+/) { $new--; } + else { error("Malformed patch"); } + if ($old<0 || $new<0) { error("Malformed patch"); } + } + } + } + } +} +error("No patch found"); + +sub cleanup +{ + chdir($home); + `rm -rf $tprefix` unless $debug; + exit 0; +} + +sub blackhole +{ + my $reason = shift @_; + print STDERR "Blackholed: $reason\n"; + cleanup(); +} + +sub error +{ + my $reason = shift @_; + print LOG "$reason\n"; + mail_reply($reason); + cleanup(); +} + +sub process +{ + print LOG "Patch found.\n"; + print LOG "Searching for original pci.ids version.\n"; + foreach $orig (($original eq "") ? glob("$home/origs/*") : ("../../$original")) { + print LOG "Trying $orig\n"; + unlink "pci.ids"; + unlink "pci.rej"; + print LOG `/usr/bin/patch &1 >orig.db.unsorted`; + $? && error("Error parsing original ID database"); + print LOG `sort +1 orig.db`; + $? && error("Error sorting original ID database"); + print LOG `$home/tools/ids_to_dbdump &1 >new.db.unsorted`; + $? && error("Error parsing the patched pci.ids file"); + print LOG `sort +1 new.db`; + $? && error("Error sorting the patched pci.ids file"); + print LOG "Finding ID differences.\n"; + `diff -U0 new.db orig.db >diffs`; + if ($? > 256) { error("Diff failed. Why?"); } + elsif (!$?) { error("No ID changes encountered."); } + open(DIFF, "diffs") || error("Cannot open the diff"); + $subject = undef if $subject eq ''; + my $authorId = getAuthor( $author ); + my $live = (!$emulate && !$debug); + while () { + chomp; + /^(\+\+\+|---)/ && next; + /^[+-]/ || next; + ($tt,$id,$name,$stat,$cmt) = split /\t/; + if ($tt =~ /^\+(.*)/) { + defined $seen{$id} && next; + $name = $cmt = ""; + } elsif ($tt =~ /^-(.*)/) { + $seen{$id} = 1; + } else { error("Internal bug #23"); } + print LOG "$id\t$name\t$cmt\n"; + submitItem( $id, $name, $cmt, $subject, $authorId ) if $live; + } + $dbh->commit(); + close DIFF; + $time = localtime; + `echo >>$home/log/mailbot.log "## $time $reply"`; + `cat result >>$home/log/mailbot.log`; + print LOG "Done.\n"; + mail_reply("OK"); + cleanup(); + } + } + error("Unable to find any version of pci.ids the patch applies to."); +} + +sub mail_reply +{ + my $reason = shift @_; + my $sendmail_opts = "-fmj+iderr\@ucw.cz '$reply_plain' mj+idecho\@ucw.cz"; + if ($debug || $reply eq "") { + print "$reason\n"; + return; + } elsif ($emulate) { + open(MAIL, ">&STDOUT") || die; + print MAIL "SENDMAIL $sendmail_opts\n"; + } elsif (!open MAIL, "|/usr/sbin/sendmail $sendmail_opts") { + print STDERR "Unable to ask mailer for replying!!!\n"; + print LOG "Unable to ask mailer for replying!!!\n"; + exit 1; + } + print MAIL "From: The PCI ID Robot \n"; + print MAIL "To: $reply\n"; + print MAIL "Subject: IDbot: $reason\n"; + print MAIL "In-Reply-To: $msgid\n" if $msgid ne ""; + print MAIL "\n"; + print MAIL <) { print MAIL "$_"; } + close L; + } + print MAIL "\n--- End ---\n"; + close MAIL; +} + +sub url_encode +{ + $_ = shift @_; + s/([^a-zA-Z0-9.!*,_-])/'%'.unpack('H2',$1)/ge; + s/%20/+/g; + $_; +} diff --git a/internet/impl/scripts/rights.pl b/internet/impl/scripts/rights.pl new file mode 100755 index 0000000..cf7434d --- /dev/null +++ b/internet/impl/scripts/rights.pl @@ -0,0 +1,61 @@ +#!/usr/bin/perl + +use strict; +BEGIN { + unshift @INC, "."; +} +use PciIds::Db; +use PciIds::DBQAny; +use PciIds::Users; + +my( $privnums, $privnames ) = getRightDefs(); + +sub userRights( $$ ) { + my( $tables, $user ) = @_; + foreach( @{$tables->query( 'rightsName', [ $user, $user ] )} ) { + my( $rid ) = @{$_}; + print " $privnames->{$rid} ($rid)\n"; + } +} + +my $dbh = connectDb(); +my $tables = PciIds::DBQAny::new( $dbh, { + 'rightsName' => 'SELECT rightId FROM users INNER JOIN rights ON users.id = rights.userId WHERE users.email = ? OR users.login = ? ORDER BY rightId', + 'allrights' => 'SELECT users.id, users.login, users.email, rights.rightId FROM users INNER JOIN rights ON users.id = rights.userId ORDER BY users.login, users.email, users.id, rights.rightId', + 'getId' => 'SELECT id FROM users WHERE email = ? OR login = ?', + 'add' => 'INSERT INTO rights (userId, rightId) VALUES(?, ?)', + 'del' => 'DELETE FROM rights WHERE userId = ? AND rightId = ?' +}); + +while( scalar @ARGV ) { + my $cmd = shift @ARGV; + if( $cmd eq '-a' ) { + my $lastid = undef; + foreach( @{$tables->query( 'allrights', [] )} ) { + my( $id, $name, $mail, $rid ) = @{$_}; + if( $id != $lastid ) { + print "$mail ($id)\t$name\n"; + $lastid = $id; + } + print " $privnames->{$rid} ($rid)\n"; + } + } elsif( $cmd =~ /^[+-]l?$/ ) { + my $user = shift @ARGV; + my $id = $tables->query( 'getId', [ $user, $user ] )->[ 0 ]->[ 0 ]; + die "Invalid user $user\n" unless( defined $id ); + my $right = $privnums->{shift @ARGV}; + die "Invalid right $right\n" unless( defined $right ); + my @params = ( $id, $right ); + my $q = ( $cmd =~ /-/ ) ? 'del' : 'add'; + $tables->command( $q, \@params ); + } elsif( $cmd eq '-h' ) { + print "rights.pl username\t\t\tPrint user's rights\n"; + print "rights.pl -a\t\t\t\tPrint all users and their rights\n"; + print "rights.pl +/- user right\t\tGrant/revoke user's right\n"; + } else { + print "$cmd\n"; + userRights( $tables, $cmd ); + } +} +$dbh->commit(); +$dbh->disconnect(); diff --git a/internet/impl/scripts/send_notifs.pl b/internet/impl/scripts/send_notifs.pl new file mode 100755 index 0000000..aca6a05 --- /dev/null +++ b/internet/impl/scripts/send_notifs.pl @@ -0,0 +1,18 @@ +#!/usr/bin/perl + +use strict; +use warnings; +BEGIN { + unshift @INC, "."; +} +use PciIds::DBQ; +use PciIds::Db; +use PciIds::Notifications; +use PciIds::Xmpp; + +my $dbh = connectDb(); +my $tables = PciIds::DBQ::new( $dbh ); + +sendNotifs( $tables ); +flushXmpp(); +$tables->commit(); diff --git a/internet/impl/scripts/transfer.pl b/internet/impl/scripts/transfer.pl new file mode 100755 index 0000000..14c5a9a --- /dev/null +++ b/internet/impl/scripts/transfer.pl @@ -0,0 +1,77 @@ +#!/usr/bin/perl + +use strict; +use warnings; +BEGIN { + unshift @INC, "."; +} +use PciIds::Db; +use PciIds::Config; +use DBI; + +my( $orig ) = @ARGV; +my $newdb = connectDb(); +my( $user, $passwd ) = confList( [ "dbuser", "dbpasswd" ] ); +my $olddb = DBI->connect( "dbi:mysql:$orig", $user, $passwd, { 'RaiseError' => 1 } ); + +print "Submiting ordinary users\n"; +my $uquery = $olddb->prepare( "SELECT DISTINCT author FROM ids WHERE author like '%@%'" ); +my $upush = $newdb->prepare( "INSERT INTO users (email, passwd) VALUES (?, '')" ); +$uquery->execute(); +my %users = ( '' => undef ); + +while( my( $author ) = $uquery->fetchrow_array ) { + $upush->execute( $author ); + $users{$author} = $newdb->last_insert_id( undef, undef, undef, undef ); +} + +my $clean = $newdb->prepare( "DELETE FROM locations WHERE id like 'PC/%'" ); +print "Cleaning old PCI devices to make place for new ones\n"; +$clean->execute(); +print "Submiting items from database\n"; + +my $itemq = $olddb->prepare( "SELECT id, name, comment, author, status, type FROM ids ORDER BY LENGTH(id), id" ); +my $itemp = $newdb->prepare( "INSERT INTO locations (id, parent) VALUES (?, ?)" ); +my $comp = $newdb->prepare( "INSERT INTO history (owner, location, nodename, nodedescription, seen, time) VALUES (?, ?, ?, ?, ?, '2000-01-01 00:00:00')" ); +my $setMain = $newdb->prepare( 'UPDATE locations SET + maincomment = ?, + name = ( SELECT nodename FROM history WHERE id = ? ), + description = ( SELECT nodedescription FROM history WHERE id = ? ) + WHERE + id = ?' ); + +my %rex = ( + 'v' => sub { + my $i = shift; + "PC/$i"; + }, + 'd' => sub { + my $i = shift; + $i =~ s/(.{4,4})(.*)/PC\/$1\/$2/; + return $i; + }, + 's' => sub { + my $i = shift; + $i =~ s/(.{4,4})(.{4,4})(.*)/PC\/$1\/$2\/$3/; + return $i; + } +); + +$itemq->execute(); +while( my( $id, $name, $description, $author, $status, $type ) = $itemq->fetchrow_array ) { + $id = &{$rex{$type}}( $id ); + my $parent = $id; + $parent =~ s/\/[^\/]+$//; + eval {#Add it if not present yet + $itemp->execute( $id, $parent ); + }; + $author = '' unless( defined $author ); + $comp->execute( $users{$author} ? $users{$author} : undef, $id, $name, $description, !$status ); + unless( $status ) { + my $last = $newdb->last_insert_id( undef, undef, undef, undef ); + $setMain->execute( $last, $last, $last, $id ); + } +} + +$newdb->commit(); +$newdb->disconnect(); diff --git a/internet/impl/static/print.css b/internet/impl/static/print.css new file mode 100644 index 0000000..2f718ec --- /dev/null +++ b/internet/impl/static/print.css @@ -0,0 +1,27 @@ +.menu, .navigation +{ + overflow: hidden; + display: none; +} +.author, .time +{ + font-style: italic; +} +.itemname, .name +{ + font-weight: bold; +} +.itemdescription, .description +{ + font-style: italic; + font-weight: bold; +} +.unnamedItem +{ + font-style: italic; +} +.comment, .unseen-comment, .main-comment +{ + border-bottom: dotted; + border-bottom-width: 1px; +} diff --git a/internet/impl/static/screen.css b/internet/impl/static/screen.css new file mode 100644 index 0000000..e8e66a0 --- /dev/null +++ b/internet/impl/static/screen.css @@ -0,0 +1,45 @@ +body +{ + color: black; + background: #DDDDFF; +} +.unnamedItem, .unseen-comment +{ + background: #D5D5D5; +} +.item, .comment +{ + background: #F0F0F0; +} +.main-comment +{ + background: #DDFFDD; +} +.itemname, .name +{ + font-weight: bold; +} +.itemdescription, .description +{ + font-weight: bold; + font-style: italic; +} +.error +{ + font-weight: bold; + color: red; +} +.author, .time +{ + font-style: italic; + color: #444444; +} +.discussion div p, .admin div p +{ + padding-left: 5px; + padding-right: 5px; +} +.menu ul +{ + list-style-type: none; +} diff --git a/internet/impl/tables b/internet/impl/tables new file mode 100644 index 0000000..f42c611 --- /dev/null +++ b/internet/impl/tables @@ -0,0 +1,88 @@ +@users +#Each row represents a registered user, with privileges or without +id INT UNSIGNED NOT NULL AUTO_INCREMENT UNIQUE PRIMARY KEY,#Internal ID +email VARCHAR(255) <> UNIQUE NOT NULL,#His email for notifications +xmpp TEXT <>,#His XMPP address for notifications +login VARCHAR(50) <> UNIQUE,#Login name +passwd VARCHAR(22) <> NOT NULL,#Password hash +lastlog TEXT <>,#Where did he logged in last time? +logtime TIMESTAMP,#When did he log in last time? +mailgather INT UNSIGNED NOT NULL DEFAULT 240,#How long to gather mail notifications before sending? +xmppgather INT UNSIGNED NOT NULL DEFAULT 15,#How long to gather xmpp notifications before sending? +nextmail TIMESTAMP,#When do we send pending email notifications next time? +nextxmpp TIMESTAMP#When do we send pending xmpp notifications? + +@locations +#The locations are saved in a tree. ID of the location is created by +#appending the local IDs of the nodes on the path together (children of +#the root first), separated by '/'. Each node must know, how long are +#the local IDs of its children. +# +#(Note that the local IDs can contain '/', since it can be recognized +#by its length.) +# +#The first part is 2-letter specifier of information type. The first +#version has these: +#PC: PCI ID +#PD: PCI Device Class +# +id VARCHAR(50) <> NOT NULL UNIQUE PRIMARY KEY,#The name of the location, must be just node, no / at the end +parent VARCHAR(50) <>,#To allow selecting of all node's children +maincomment INT UNSIGNED,#Reference for the main comment +name TINYTEXT <>,#Should match the one of main comment, if any (if no main comment, name can be set too) +description TEXT <>,#Should match the one of main comment (if no main comment, can be set too) +CONSTRAINT parent_ref FOREIGN KEY (parent) REFERENCES locations(id) ON DELETE CASCADE + +@rights +#Which privileges the users have? +#It contains only the users with some extra privileges, not the normal ones +userId INT UNSIGNED NOT NULL,#Who has the privilege +rightId INT UNSIGNED NOT NULL,#What privilege +CONSTRAINT right_user FOREIGN KEY (userId) REFERENCES users(id) ON DELETE CASCADE, +PRIMARY KEY (userId, rightId) + +@history +#Contains the comments in the discussion +id INT UNSIGNED NOT NULL AUTO_INCREMENT UNIQUE PRIMARY KEY, +owner INT UNSIGNED,#Who posted it? +location VARCHAR(50) <> NOT NULL,#Where it belongs +text TEXT <>, +time TIMESTAMP NOT NULL DEFAULT NOW(),#When this was added +nodename TINYTEXT <>,#Modification of the location name +nodedescription TEXT <>,#Modification of the location comment +seen BOOLEAN NOT NULL DEFAULT '0', #Did some admin see this, or is it still unseen? +CONSTRAINT history_location FOREIGN KEY (location) REFERENCES locations(id) ON DELETE CASCADE, +CONSTRAINT history_owner FOREIGN KEY (owner) REFERENCES users(id) ON DELETE SET NULL + +@notifications +#Contains hooks for notifications +user INT UNSIGNED NOT NULL,#Who wants it +location VARCHAR(50) <> NOT NULL,#Where +recursive BOOLEAN NOT NULL DEFAULT '0', +type SMALLINT NOT NULL,#When to send +#0: Comment -- When a new comment is posted +#1: Description -- Name or comment changed +#2: MainComment -- The main comment changed +#All contains the less common events +notification SMALLINT NOT NULL, +#0: mail only +#1: xmpp only +#2: both +CONSTRAINT notification_location FOREIGN KEY (location) REFERENCES locations(id) ON DELETE CASCADE, +CONSTRAINT notification_user FOREIGN KEY (user) REFERENCES users(id) ON DELETE CASCADE, +PRIMARY KEY (user, location) + +@pending +#Contains the pending notifications +user INT UNSIGNED NOT NULL, +comment INT UNSIGNED NOT NULL, +notification SMALLINT NOT NULL, +#0: mail +#1: xmpp +#If a notification generates both, it splits to 2 of them +reason SMALLINT NOT NULL, +#0: New item +#1: New comment +#2: Changed main article +CONSTRAINT pending_comment FOREIGN KEY (comment) REFERENCES history(id) ON DELETE CASCADE, +CONSTRAINT pending_user FOREIGN KEY (user) REFERENCES users(id) ON DELETE CASCADE diff --git a/internet/specifikace.txt b/internet/specifikace.txt new file mode 100644 index 0000000..51950de --- /dev/null +++ b/internet/specifikace.txt @@ -0,0 +1,19 @@ + PCI IDčkovátko +================ +Webová aplikace pro ukládání a updatování informací o PCI ID zařízení. +Je to přepsání již existující a nasazené aplikace, která postrádá +některé žádané schopnosti (http://pci-ids.ucw.cz/). + +Ke každému objektu (tedy, PCI ID, ID výrobce, ID subsystému, ID třídy +zařízení) bude možno vést diskusi, ve které bude možnost jednak psát +komentáře a jednak zasílat nové verze popisu ID. Pro tuto diskusi bude +možné objednat upozornění mailem (a to buď pro každou úpravu zvlášť, +nebo dávkově). + +Diskuse bude chráněná registrací s ověřením emailové adresy. Tato +adresa bude jednak zobrazena a zpřístupněna administrátorům, jednak +bude sloužit k zasílání upozornění. + +Administrátor bude mít schopnost mazat příspěvky. Taktéž bude moct +označit (či odznačit) některou verzi informací o daném ID jako +finální. -- 2.39.2