├── data ├── epx.png ├── fsmileys.png ├── pwrd_mysql.png ├── pwrd_perl.png ├── pwrd_pgsql.png ├── buttonicons.png ├── pwrd_apache.png ├── pwrd_mariadb.png ├── pwrd_modperl.png ├── pwrd_sqlite.png ├── default2 │ └── icons.png ├── pwrd_lighttpd.png └── google.js ├── example ├── script.htaccess ├── opensearch.xml ├── attach.htaccess ├── MwfPlgAuthz.pm ├── MwfPlgMsgDisplay.pm └── MwfPlgEvent.pm ├── script ├── MwfConfigGlobalDefault.pm ├── user_logout.pl ├── note_delete.pl ├── group_add.pl ├── forum.pl ├── user_delete.pl ├── categ_add.pl ├── chat_delete.pl ├── ajax_dataversion.pl ├── ajax_usernames.pl ├── categ_delete.pl ├── report_delete.pl ├── board_add.pl ├── topic_stick.pl ├── forum_help.pl ├── user_unsubscribe.pl ├── post_lock.pl ├── topic_lock.pl ├── group_delete.pl ├── board_delete.pl ├── spawn_test.pl ├── chat_add.pl ├── categ_toggle.pl ├── forum_feeds.pl ├── post_like.pl ├── ajax_check.pl ├── post_approve.pl ├── MwfConfigDefault.pm ├── categ_admin.pl ├── branch_delete.pl ├── poll_delete.pl ├── log_delete.pl ├── user_ticket.pl ├── forum_policy.pl ├── group_admin.pl ├── topic_delete.pl ├── poll_lock.pl ├── branch_lock.pl ├── user_notify.pl ├── message_delete.pl ├── attach_show.pl ├── cron_admin.pl ├── topic_info.pl ├── user_mark.pl ├── user_wipe.pl ├── chat_show.pl ├── message_export.pl ├── post_delete.pl ├── board_archive.pl ├── board_merge.pl ├── user_confirm.pl ├── spawn_upgrade.pl ├── user_migrate.pl ├── user_set.pl ├── forum_activity.pl ├── user_name.pl ├── user_countries.pl ├── user_password.pl ├── categ_options.pl ├── cron_bounce.pl └── report_list.pl ├── doc └── doc.css └── util ├── util_groupconcat4pg.sql ├── util_deleteusers.pl ├── util_tables2engine.sql ├── util_citext.pl ├── util_text2medium.sql ├── util_fixtablecase.sql ├── util_fixcharset.pl ├── util_replace.pl └── util_cleancfg.pl /data/epx.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/quit/mwForum/master/data/epx.png -------------------------------------------------------------------------------- /data/fsmileys.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/quit/mwForum/master/data/fsmileys.png -------------------------------------------------------------------------------- /data/pwrd_mysql.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/quit/mwForum/master/data/pwrd_mysql.png -------------------------------------------------------------------------------- /data/pwrd_perl.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/quit/mwForum/master/data/pwrd_perl.png -------------------------------------------------------------------------------- /data/pwrd_pgsql.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/quit/mwForum/master/data/pwrd_pgsql.png -------------------------------------------------------------------------------- /data/buttonicons.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/quit/mwForum/master/data/buttonicons.png -------------------------------------------------------------------------------- /data/pwrd_apache.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/quit/mwForum/master/data/pwrd_apache.png -------------------------------------------------------------------------------- /data/pwrd_mariadb.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/quit/mwForum/master/data/pwrd_mariadb.png -------------------------------------------------------------------------------- /data/pwrd_modperl.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/quit/mwForum/master/data/pwrd_modperl.png -------------------------------------------------------------------------------- /data/pwrd_sqlite.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/quit/mwForum/master/data/pwrd_sqlite.png -------------------------------------------------------------------------------- /data/default2/icons.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/quit/mwForum/master/data/default2/icons.png -------------------------------------------------------------------------------- /data/pwrd_lighttpd.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/quit/mwForum/master/data/pwrd_lighttpd.png -------------------------------------------------------------------------------- /example/script.htaccess: -------------------------------------------------------------------------------- 1 | # Disable browsing this directory 2 | 3 | Options -Indexes 4 | 5 | # Deny downloading of Perl modules 6 | 7 | 8 | Order allow,deny 9 | Deny from all 10 | 11 | -------------------------------------------------------------------------------- /example/opensearch.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | Example Forum 4 | Search the Example forum. 5 | 6 | http://www.example.org/favicon.ico 7 | utf-8 8 | utf-8 9 | 10 | -------------------------------------------------------------------------------- /script/MwfConfigGlobalDefault.pm: -------------------------------------------------------------------------------- 1 | package MwfConfigGlobal; 2 | use strict; 3 | use warnings; 4 | our ($VERSION, $gcfg); 5 | $VERSION = "2.23.0"; 6 | 7 | #------------------------------------------------------------------------------ 8 | # Multi-forum options 9 | # Only touch if you want to use the multi-forum support. See FAQ.html. 10 | 11 | # Map hostnames or URL paths to forums 12 | #$gcfg->{forums} = { 13 | # 'foo.example.com' => 'MwfConfigFoo', 14 | # 'bar.example.com' => 'MwfConfigBar', 15 | #}; 16 | #$gcfg->{forums} = { 17 | # '/perl/foo' => 'MwfConfigFoo', 18 | # '/perl/bar' => 'MwfConfigBar', 19 | #}; 20 | 21 | # Database name of one of the used databases under MySQL 22 | #$gcfg->{dbName} = ""; 23 | 24 | #----------------------------------------------------------------------------- 25 | # Advanced options 26 | 27 | # Print page creation time? 28 | # Measures runtime, not CPU-time and not overhead like compilation time. 29 | $gcfg->{pageTime} = 0; 30 | 31 | # Script filename extension 32 | $gcfg->{ext} = ".pl"; 33 | 34 | #----------------------------------------------------------------------------- 35 | # Return OK 36 | 1; 37 | -------------------------------------------------------------------------------- /doc/doc.css: -------------------------------------------------------------------------------- 1 | body { 2 | background-color: white; 3 | font-family: verdana, sans-serif; 4 | font-size: 13px; 5 | } 6 | 7 | h1, h2, h3, h4 { 8 | font-family: arial, sans-serif; 9 | } 10 | 11 | h2 { 12 | margin-top: 30px; 13 | border-top: 1px solid black; 14 | padding-top: 10px; 15 | } 16 | 17 | h3, h4 { 18 | margin-left: 15px; 19 | } 20 | 21 | code, samp, kbd, var, dl.ids dt { 22 | font-family: 'andale mono', monospace; 23 | font-size: 12px; 24 | } 25 | 26 | var { 27 | white-space: nowrap; 28 | } 29 | 30 | code { 31 | color: teal; 32 | } 33 | 34 | samp { 35 | color: maroon; 36 | } 37 | 38 | kbd { 39 | color: green; 40 | } 41 | 42 | var, dl.ids dt { 43 | color: gray; 44 | font-style: normal; 45 | } 46 | 47 | p { 48 | margin-left: 15px; 49 | margin-right: 15px; 50 | } 51 | 52 | pre { 53 | margin-left: 30px; 54 | margin-top: -1em; 55 | } 56 | 57 | ul.ext li, ol.ext li { 58 | margin-top: 1em; 59 | margin-bottom: 1em; 60 | } 61 | 62 | li pre { 63 | margin-left: 15px; 64 | margin-top: 0; 65 | } 66 | 67 | blockquote { 68 | font-style: italic; 69 | } 70 | 71 | a { 72 | text-decoration: none; 73 | } 74 | 75 | dt { 76 | margin: 10px 15px 0 30px; 77 | } 78 | 79 | dd { 80 | margin: 0 15px 0 45px; 81 | } 82 | -------------------------------------------------------------------------------- /script/user_logout.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | #------------------------------------------------------------------------------ 3 | # mwForum - Web-based discussion forum 4 | # Copyright (c) 1999-2015 Markus Wichitill 5 | # 6 | # This program is free software; you can redistribute it and/or modify 7 | # it under the terms of the GNU General Public License as published by 8 | # the Free Software Foundation; either version 3 of the License, or 9 | # (at your option) any later version. 10 | # 11 | # This program is distributed in the hope that it will be useful, 12 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | # GNU General Public License for more details. 15 | #------------------------------------------------------------------------------ 16 | 17 | use strict; 18 | use warnings; 19 | no warnings qw(uninitialized redefine); 20 | 21 | # Imports 22 | use MwfMain; 23 | 24 | #------------------------------------------------------------------------------ 25 | 26 | # Init 27 | my ($m, $cfg, $lng, $user, $userId) = MwfMain->new($_[0], allowBanned => 1); 28 | 29 | if ($userId) { 30 | # Check request source authentication 31 | $m->checkSourceAuth() or $m->error('errSrcAuth'); 32 | 33 | # Remove id/pwd cookies 34 | $m->deleteCookie('login'); 35 | } 36 | 37 | # Log action and finish 38 | $m->logAction(1, 'user', 'logout', $userId); 39 | $m->redirect('forum_show'); 40 | -------------------------------------------------------------------------------- /example/attach.htaccess: -------------------------------------------------------------------------------- 1 | # Force downloading of attachments instead of opening them in website context, 2 | # which can be very dangerous, allowing account hijacking etc. Does not have any 3 | # effect on embedded images. Very important. 4 | 5 | Header set Content-Disposition "attachment" 6 | Header set X-Download-Options "noopen" 7 | 8 | # Disable execution via CGI, PHP etc. Very important. 9 | 10 | Options -ExecCGI 11 | SetHandler default-handler 12 | 13 | # Disable browsing this directory. Always recommended, since there are so many 14 | # useless bots out there that download everything in their way. 15 | # Very important if you have private boards with attachments that are supposed 16 | # to be secret. 17 | 18 | Options -Indexes 19 | 20 | # Treat files with unregistered extensions as binary files. 21 | # Helps against "alphabet soup" downloads. Not very important. 22 | 23 | DefaultType application/octet-stream 24 | 25 | # Set more specific MIME types for feeds. Not important. 26 | 27 | 28 | ForceType application/atom+xml 29 | 30 | 31 | ForceType application/rss+xml 32 | 33 | 34 | # Block access to OpenID cache. 35 | 36 | 37 | Deny from all 38 | 39 | 40 | # Block access to PGP user keyrings. They only contain public keys, though, 41 | # so this is usually unnecessary. 42 | 43 | 44 | Deny from all 45 | 46 | -------------------------------------------------------------------------------- /script/note_delete.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | #------------------------------------------------------------------------------ 3 | # mwForum - Web-based discussion forum 4 | # Copyright (c) 1999-2015 Markus Wichitill 5 | # 6 | # This program is free software; you can redistribute it and/or modify 7 | # it under the terms of the GNU General Public License as published by 8 | # the Free Software Foundation; either version 3 of the License, or 9 | # (at your option) any later version. 10 | # 11 | # This program is distributed in the hope that it will be useful, 12 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | # GNU General Public License for more details. 15 | #------------------------------------------------------------------------------ 16 | 17 | use strict; 18 | use warnings; 19 | no warnings qw(uninitialized redefine); 20 | 21 | # Imports 22 | use MwfMain; 23 | 24 | #------------------------------------------------------------------------------ 25 | 26 | # Init 27 | my ($m, $cfg, $lng, $user, $userId) = MwfMain->new($_[0]); 28 | 29 | # Check if access should be denied 30 | $userId or $m->error('errNoAccess'); 31 | 32 | # Check request source authentication 33 | $m->checkSourceAuth() or $m->error('errSrcAuth'); 34 | 35 | # Delete notifications 36 | $m->dbDo(" 37 | DELETE FROM notes WHERE userId = ?", $userId); 38 | 39 | # Log action and finish 40 | $m->logAction(1, 'note', 'delete', $userId); 41 | $m->redirect('forum_show', msg => 'NotesDel'); 42 | -------------------------------------------------------------------------------- /script/group_add.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | #------------------------------------------------------------------------------ 3 | # mwForum - Web-based discussion forum 4 | # Copyright (c) 1999-2015 Markus Wichitill 5 | # 6 | # This program is free software; you can redistribute it and/or modify 7 | # it under the terms of the GNU General Public License as published by 8 | # the Free Software Foundation; either version 3 of the License, or 9 | # (at your option) any later version. 10 | # 11 | # This program is distributed in the hope that it will be useful, 12 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | # GNU General Public License for more details. 15 | #------------------------------------------------------------------------------ 16 | 17 | use strict; 18 | use warnings; 19 | no warnings qw(uninitialized redefine); 20 | 21 | # Imports 22 | use MwfMain; 23 | 24 | #------------------------------------------------------------------------------ 25 | 26 | # Init 27 | my ($m, $cfg, $lng, $user, $userId) = MwfMain->new($_[0]); 28 | 29 | # Check if user is admin 30 | $user->{admin} or $m->error('errNoAccess'); 31 | 32 | # Check request source authentication 33 | $m->checkSourceAuth() or $m->error('errSrcAuth'); 34 | 35 | # Insert new group 36 | $m->dbDo(" 37 | INSERT INTO groups (title) VALUES (?)", 38 | "New Group"); 39 | my $groupId = $m->dbInsertId("groups"); 40 | 41 | # Log action and finish 42 | $m->logAction(1, 'group', 'add', $userId, 0, 0, 0, $groupId); 43 | $m->redirect('group_options', gid => $groupId); 44 | -------------------------------------------------------------------------------- /util/util_groupconcat4pg.sql: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------- 2 | -- mwForum - Web-based discussion forum 3 | -- Copyright (c) 1999-2015 Markus Wichitill 4 | -- 5 | -- This program is free software; you can redistribute it and/or modify 6 | -- it under the terms of the GNU General Public License as published by 7 | -- the Free Software Foundation; either version 3 of the License, or 8 | -- (at your option) any later version. 9 | -- 10 | -- This program is distributed in the hope that it will be useful, 11 | -- but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | -- GNU General Public License for more details. 14 | ------------------------------------------------------------------------------- 15 | 16 | CREATE OR REPLACE FUNCTION group_concat_sfunc(TEXT, INTEGER) 17 | RETURNS TEXT AS $$ 18 | SELECT CASE 19 | WHEN $2 IS NULL THEN $1 20 | WHEN $1 IS NULL THEN $2::TEXT 21 | ELSE $1 || ',' || $2::TEXT 22 | END 23 | $$ LANGUAGE SQL IMMUTABLE; 24 | 25 | CREATE OR REPLACE FUNCTION group_concat_sfunc(TEXT, TEXT) 26 | RETURNS TEXT AS $$ 27 | SELECT CASE 28 | WHEN $2 IS NULL THEN $1 29 | WHEN $1 IS NULL THEN $2 30 | ELSE $1 || ',' || $2 31 | END 32 | $$ LANGUAGE SQL IMMUTABLE; 33 | 34 | DROP AGGREGATE IF EXISTS group_concat(INTEGER); 35 | CREATE AGGREGATE group_concat(INTEGER) ( 36 | STYPE = TEXT, 37 | SFUNC = group_concat_sfunc 38 | ); 39 | 40 | DROP AGGREGATE IF EXISTS group_concat(TEXT); 41 | CREATE AGGREGATE group_concat(TEXT) ( 42 | STYPE = TEXT, 43 | SFUNC = group_concat_sfunc 44 | ); 45 | -------------------------------------------------------------------------------- /script/forum.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | #------------------------------------------------------------------------------ 3 | # mwForum - Web-based discussion forum 4 | # Copyright (c) 1999-2015 Markus Wichitill 5 | # 6 | # This program is free software; you can redistribute it and/or modify 7 | # it under the terms of the GNU General Public License as published by 8 | # the Free Software Foundation; either version 3 of the License, or 9 | # (at your option) any later version. 10 | # 11 | # This program is distributed in the hope that it will be useful, 12 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | # GNU General Public License for more details. 15 | #------------------------------------------------------------------------------ 16 | 17 | use strict; 18 | use warnings; 19 | no warnings qw(uninitialized redefine); 20 | 21 | # Imports 22 | use MwfMain; 23 | 24 | #------------------------------------------------------------------------------ 25 | 26 | # Init 27 | my ($m, $cfg, $lng, $user, $userId) = MwfMain->new($_[0]); 28 | 29 | # Get CGI parameters 30 | my $boardId = $m->paramInt('bid'); 31 | 32 | # Update user's previous online time 33 | if ($userId) { 34 | my $prevOnCookie = int($m->getCookie('prevon') || 0); 35 | my $prevOnTime = $m->max($prevOnCookie, $user->{lastOnTime}) || $m->{now}; 36 | $m->{userUpdates}{prevOnTime} = $prevOnTime; 37 | $m->setCookie('prevon', $prevOnTime); 38 | } 39 | 40 | # Log action and finish 41 | $m->logAction(2, 'forum', 'enter', $userId); 42 | if ($boardId) { $m->redirect('board_show', bid => $boardId) } 43 | else { $m->redirect('forum_show') } 44 | -------------------------------------------------------------------------------- /script/user_delete.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | #------------------------------------------------------------------------------ 3 | # mwForum - Web-based discussion forum 4 | # Copyright (c) 1999-2015 Markus Wichitill 5 | # 6 | # This program is free software; you can redistribute it and/or modify 7 | # it under the terms of the GNU General Public License as published by 8 | # the Free Software Foundation; either version 3 of the License, or 9 | # (at your option) any later version. 10 | # 11 | # This program is distributed in the hope that it will be useful, 12 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | # GNU General Public License for more details. 15 | #------------------------------------------------------------------------------ 16 | 17 | use strict; 18 | use warnings; 19 | no warnings qw(uninitialized redefine); 20 | 21 | # Imports 22 | use MwfMain; 23 | 24 | #------------------------------------------------------------------------------ 25 | 26 | # Init 27 | my ($m, $cfg, $lng, $user, $userId) = MwfMain->new($_[0]); 28 | 29 | # Check if user is admin 30 | $user->{admin} or $m->error('errNoAccess'); 31 | 32 | # Get CGI parameters 33 | my $delUserId = $m->paramInt('uid'); 34 | $delUserId or $m->error('errParamMiss'); 35 | 36 | # Check request source authentication 37 | $m->checkSourceAuth() or $m->error('errSrcAuth'); 38 | 39 | # Don't delete user #1 40 | $delUserId != 1 or $m->error("Deleting user #1 not allowed for security reasons."); 41 | 42 | # Delete user 43 | $m->deleteUser($delUserId); 44 | 45 | # Log action and finish 46 | $m->logAction(1, 'user', 'delete', $userId, 0, 0, 0, $delUserId); 47 | $m->redirect('user_admin'); 48 | -------------------------------------------------------------------------------- /script/categ_add.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | #------------------------------------------------------------------------------ 3 | # mwForum - Web-based discussion forum 4 | # Copyright (c) 1999-2015 Markus Wichitill 5 | # 6 | # This program is free software; you can redistribute it and/or modify 7 | # it under the terms of the GNU General Public License as published by 8 | # the Free Software Foundation; either version 3 of the License, or 9 | # (at your option) any later version. 10 | # 11 | # This program is distributed in the hope that it will be useful, 12 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | # GNU General Public License for more details. 15 | #------------------------------------------------------------------------------ 16 | 17 | use strict; 18 | use warnings; 19 | no warnings qw(uninitialized redefine); 20 | 21 | # Imports 22 | use MwfMain; 23 | 24 | #------------------------------------------------------------------------------ 25 | 26 | # Init 27 | my ($m, $cfg, $lng, $user, $userId) = MwfMain->new($_[0]); 28 | 29 | # Check if user is admin 30 | $user->{admin} or $m->error('errNoAccess'); 31 | 32 | # Check request source authentication 33 | $m->checkSourceAuth() or $m->error('errSrcAuth'); 34 | 35 | # Get position 36 | my $pos = $m->fetchArray(" 37 | SELECT COALESCE(MAX(pos), 0) + 1 FROM categories"); 38 | 39 | # Insert new category 40 | $m->dbDo(" 41 | INSERT INTO categories (title, pos) VALUES (?, ?)", 42 | 'New Category', $pos); 43 | my $categId = $m->dbInsertId("categories"); 44 | 45 | # Log action and finish 46 | $m->logAction(1, 'categ', 'add', $userId, 0, 0, 0, $categId); 47 | $m->redirect('categ_options', cid => $categId); 48 | -------------------------------------------------------------------------------- /script/chat_delete.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | #------------------------------------------------------------------------------ 3 | # mwForum - Web-based discussion forum 4 | # Copyright (c) 1999-2015 Markus Wichitill 5 | # 6 | # This program is free software; you can redistribute it and/or modify 7 | # it under the terms of the GNU General Public License as published by 8 | # the Free Software Foundation; either version 3 of the License, or 9 | # (at your option) any later version. 10 | # 11 | # This program is distributed in the hope that it will be useful, 12 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | # GNU General Public License for more details. 15 | #------------------------------------------------------------------------------ 16 | 17 | use strict; 18 | use warnings; 19 | no warnings qw(uninitialized redefine); 20 | 21 | # Imports 22 | use MwfMain; 23 | 24 | #------------------------------------------------------------------------------ 25 | 26 | # Init 27 | my ($m, $cfg, $lng, $user, $userId) = MwfMain->new($_[0]); 28 | 29 | # Check if user is admin 30 | $user->{admin} or $m->error('errNoAccess'); 31 | 32 | # Get CGI parameters 33 | my $action = $m->paramStrId('act'); 34 | my $chatId = $m->paramInt('chatId'); 35 | 36 | # Check request source authentication 37 | $m->checkSourceAuth() or $m->error('errSrcAuth'); 38 | 39 | if ($action eq 'all') { 40 | # Delete all chat messages 41 | $m->dbDo(" 42 | DELETE FROM chat"); 43 | } 44 | else { 45 | # Delete chat message 46 | $m->dbDo(" 47 | DELETE FROM chat WHERE id = ?", $chatId); 48 | } 49 | 50 | # Log action and finish 51 | $m->logAction(1, 'chat', 'delete', $userId, 0, 0, 0, $chatId); 52 | $m->redirect('chat_show', msg => 'ChatDel'); 53 | -------------------------------------------------------------------------------- /script/ajax_dataversion.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | #------------------------------------------------------------------------------ 3 | # mwForum - Web-based discussion forum 4 | # Copyright (c) 1999-2015 Markus Wichitill 5 | # 6 | # This program is free software; you can redistribute it and/or modify 7 | # it under the terms of the GNU General Public License as published by 8 | # the Free Software Foundation; either version 3 of the License, or 9 | # (at your option) any later version. 10 | # 11 | # This program is distributed in the hope that it will be useful, 12 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | # GNU General Public License for more details. 15 | #------------------------------------------------------------------------------ 16 | 17 | use strict; 18 | use warnings; 19 | no warnings qw(uninitialized redefine); 20 | 21 | # Imports 22 | use MwfMain; 23 | 24 | #------------------------------------------------------------------------------ 25 | 26 | # Init 27 | my ($m, $cfg, $lng, $user, $userId) = MwfMain->new($_[0], ajax => 1); 28 | 29 | # Check if user is admin 30 | $user->{admin} or $m->error('errNoAccess'); 31 | 32 | # Check if feature is enabled 33 | $cfg->{dataVersion} or $m->error("Feature is disabled."); 34 | 35 | # Increase data version 36 | my $dataVersion = $cfg->{dataVersion} + 1; 37 | $m->dbDo(" 38 | UPDATE config SET value = ? WHERE name = ?", $dataVersion, 'dataVersion'); 39 | $m->dbDo(" 40 | UPDATE config SET value = ? WHERE name = ?", $m->{now}, 'lastUpdate'); 41 | 42 | # Answer in JSON 43 | $m->printHttpHeader(); 44 | print $m->json({ dataVersion => $dataVersion }); 45 | 46 | # Log action and commit 47 | $m->logAction(1, 'ajax', 'dataver', $userId); 48 | $m->finish(); 49 | -------------------------------------------------------------------------------- /script/ajax_usernames.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | #------------------------------------------------------------------------------ 3 | # mwForum - Web-based discussion forum 4 | # Copyright (c) 1999-2015 Markus Wichitill 5 | # 6 | # This program is free software; you can redistribute it and/or modify 7 | # it under the terms of the GNU General Public License as published by 8 | # the Free Software Foundation; either version 3 of the License, or 9 | # (at your option) any later version. 10 | # 11 | # This program is distributed in the hope that it will be useful, 12 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | # GNU General Public License for more details. 15 | #------------------------------------------------------------------------------ 16 | 17 | use strict; 18 | use warnings; 19 | no warnings qw(uninitialized redefine); 20 | 21 | # Imports 22 | use MwfMain; 23 | 24 | #------------------------------------------------------------------------------ 25 | 26 | # Init 27 | my ($m, $cfg, $lng, $user, $userId) = MwfMain->new($_[0], ajax => 1); 28 | 29 | # Print header 30 | $m->printHttpHeader(); 31 | 32 | # Get CGI parameters 33 | my $name = $m->paramStr('q'); 34 | 35 | # Return empty in case of errors 36 | $userId || $cfg->{userList} == 1 or $m->finish(); 37 | length($name) >= 2 or $m->finish(); 38 | 39 | # Fetch names 40 | my $like = $m->{pgsql} ? 'ILIKE' : 'LIKE'; 41 | my $nameLike = $m->dbEscLike($name) . "%"; 42 | my $names = $m->fetchAllArray(" 43 | SELECT userName 44 | FROM users 45 | WHERE userName $like ? 46 | ORDER BY userName", 47 | $nameLike); 48 | 49 | # Print names 50 | print $_->[0], "\n" for @$names; 51 | 52 | # Log action and commit 53 | $m->logAction(3, 'ajax', 'unames', $userId); 54 | $m->finish(); 55 | -------------------------------------------------------------------------------- /script/categ_delete.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | #------------------------------------------------------------------------------ 3 | # mwForum - Web-based discussion forum 4 | # Copyright (c) 1999-2015 Markus Wichitill 5 | # 6 | # This program is free software; you can redistribute it and/or modify 7 | # it under the terms of the GNU General Public License as published by 8 | # the Free Software Foundation; either version 3 of the License, or 9 | # (at your option) any later version. 10 | # 11 | # This program is distributed in the hope that it will be useful, 12 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | # GNU General Public License for more details. 15 | #------------------------------------------------------------------------------ 16 | 17 | use strict; 18 | use warnings; 19 | no warnings qw(uninitialized redefine); 20 | 21 | # Imports 22 | use MwfMain; 23 | 24 | #------------------------------------------------------------------------------ 25 | 26 | # Init 27 | my ($m, $cfg, $lng, $user, $userId) = MwfMain->new($_[0]); 28 | 29 | # Check if user is admin 30 | $user->{admin} or $m->error('errNoAccess'); 31 | 32 | # Get CGI parameters 33 | my $categId = $m->paramInt('cid'); 34 | $categId or $m->error('errParamMiss'); 35 | 36 | # Check request source authentication 37 | $m->checkSourceAuth() or $m->error('errSrcAuth'); 38 | 39 | # Only delete category when empty 40 | !$m->fetchArray(" 41 | SELECT id FROM boards WHERE categoryId = ?", $categId) 42 | or $m->error("Category is not empty."); 43 | 44 | # Delete category 45 | $m->dbDo(" 46 | DELETE FROM categories WHERE id = ?", $categId); 47 | 48 | # Log action and finish 49 | $m->logAction(1, 'categ', 'delete', $userId, 0, 0, 0, $categId); 50 | $m->redirect('categ_admin'); 51 | -------------------------------------------------------------------------------- /script/report_delete.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | #------------------------------------------------------------------------------ 3 | # mwForum - Web-based discussion forum 4 | # Copyright (c) 1999-2015 Markus Wichitill 5 | # 6 | # This program is free software; you can redistribute it and/or modify 7 | # it under the terms of the GNU General Public License as published by 8 | # the Free Software Foundation; either version 3 of the License, or 9 | # (at your option) any later version. 10 | # 11 | # This program is distributed in the hope that it will be useful, 12 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | # GNU General Public License for more details. 15 | #------------------------------------------------------------------------------ 16 | 17 | use strict; 18 | use warnings; 19 | no warnings qw(uninitialized redefine); 20 | 21 | # Imports 22 | use MwfMain; 23 | 24 | #------------------------------------------------------------------------------ 25 | 26 | # Init 27 | my ($m, $cfg, $lng, $user, $userId) = MwfMain->new($_[0]); 28 | 29 | # Get CGI parameters 30 | my $repUserId = $m->paramInt('uid'); 31 | my $postId = $m->paramInt('pid'); 32 | $postId or $m->error('errParamMiss'); 33 | 34 | # Check request source authentication 35 | $m->checkSourceAuth() or $m->error('errSrcAuth'); 36 | 37 | # Get post 38 | my ($boardId, $topicId) = $m->fetchArray(" 39 | SELECT boardId, topicId FROM posts WHERE id = ?", $postId); 40 | $boardId or $m->error('errPstNotFnd'); 41 | 42 | # Check if user is admin or moderator 43 | $user->{admin} || $m->boardAdmin($userId, $boardId) or $m->error('errNoAccess'); 44 | 45 | # Delete report 46 | $m->dbDo(" 47 | DELETE FROM postReports WHERE userId = ? AND postId = ?", $repUserId, $postId); 48 | 49 | # Log action and finish 50 | $m->logAction(1, 'report', 'delete', $userId, $boardId, $topicId, $postId); 51 | $m->redirect('report_list', msg => 'PstRemRep'); 52 | -------------------------------------------------------------------------------- /script/board_add.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | #------------------------------------------------------------------------------ 3 | # mwForum - Web-based discussion forum 4 | # Copyright (c) 1999-2015 Markus Wichitill 5 | # 6 | # This program is free software; you can redistribute it and/or modify 7 | # it under the terms of the GNU General Public License as published by 8 | # the Free Software Foundation; either version 3 of the License, or 9 | # (at your option) any later version. 10 | # 11 | # This program is distributed in the hope that it will be useful, 12 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | # GNU General Public License for more details. 15 | #------------------------------------------------------------------------------ 16 | 17 | use strict; 18 | use warnings; 19 | no warnings qw(uninitialized redefine); 20 | 21 | # Imports 22 | use MwfMain; 23 | 24 | #------------------------------------------------------------------------------ 25 | 26 | # Init 27 | my ($m, $cfg, $lng, $user, $userId) = MwfMain->new($_[0]); 28 | 29 | # Check if user is admin 30 | $user->{admin} or $m->error('errNoAccess'); 31 | 32 | # Check request source authentication 33 | $m->checkSourceAuth() or $m->error('errSrcAuth'); 34 | 35 | # Get first category id 36 | my $firstCatId = $m->fetchArray(" 37 | SELECT MIN(id) FROM categories"); 38 | $firstCatId 39 | or $m->error("Can't create board without existing category. Create a category first."); 40 | 41 | # Get position 42 | my $pos = $m->fetchArray(" 43 | SELECT COALESCE(MAX(pos), 0) + 1 FROM boards WHERE categoryId = ?", $firstCatId); 44 | 45 | # Insert new board 46 | $m->dbDo(" 47 | INSERT INTO boards (title, categoryId, pos, private) VALUES (?, ?, ?, ?)", 48 | 'New Board', $firstCatId, $pos, 1); 49 | my $boardId = $m->dbInsertId("boards"); 50 | 51 | # Log action and finish 52 | $m->logAction(1, 'board', 'add', $userId, $boardId); 53 | $m->redirect('board_options', bid => $boardId); 54 | -------------------------------------------------------------------------------- /script/topic_stick.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | #------------------------------------------------------------------------------ 3 | # mwForum - Web-based discussion forum 4 | # Copyright (c) 1999-2015 Markus Wichitill 5 | # 6 | # This program is free software; you can redistribute it and/or modify 7 | # it under the terms of the GNU General Public License as published by 8 | # the Free Software Foundation; either version 3 of the License, or 9 | # (at your option) any later version. 10 | # 11 | # This program is distributed in the hope that it will be useful, 12 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | # GNU General Public License for more details. 15 | #------------------------------------------------------------------------------ 16 | 17 | use strict; 18 | use warnings; 19 | no warnings qw(uninitialized redefine); 20 | 21 | # Imports 22 | use MwfMain; 23 | 24 | #------------------------------------------------------------------------------ 25 | 26 | # Init 27 | my ($m, $cfg, $lng, $user, $userId) = MwfMain->new($_[0]); 28 | 29 | # Get CGI parameters 30 | my $topicId = $m->paramInt('tid'); 31 | my $action = $m->paramStrId('act'); 32 | $topicId or $m->error('errParamMiss'); 33 | 34 | # Check request source authentication 35 | $m->checkSourceAuth() or $m->error('errSrcAuth'); 36 | 37 | # Get board id 38 | my $boardId = $m->fetchArray(" 39 | SELECT boardId FROM topics WHERE id = ?", $topicId); 40 | $boardId or $m->error('errTpcNotFnd'); 41 | 42 | # Check if user is admin or moderator 43 | $user->{admin} || $m->boardAdmin($userId, $boardId) or $m->error('errNoAccess'); 44 | 45 | # Lock or unlock 46 | my $sticky = $action eq "stick" ? 1 : 0; 47 | 48 | # Update 49 | $m->dbDo(" 50 | UPDATE topics SET sticky = ? WHERE id = ?", $sticky, $topicId); 51 | 52 | # Log action and finish 53 | $m->logAction(1, 'topic', $sticky ? 'stick' : 'unstick', $userId, $boardId, $topicId); 54 | $m->redirect('topic_show', tid => $topicId, msg => $sticky ? 'TpcStik' : 'TpcUnstik'); 55 | -------------------------------------------------------------------------------- /script/forum_help.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | #------------------------------------------------------------------------------ 3 | # mwForum - Web-based discussion forum 4 | # Copyright (c) 1999-2015 Markus Wichitill 5 | # 6 | # This program is free software; you can redistribute it and/or modify 7 | # it under the terms of the GNU General Public License as published by 8 | # the Free Software Foundation; either version 3 of the License, or 9 | # (at your option) any later version. 10 | # 11 | # This program is distributed in the hope that it will be useful, 12 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | # GNU General Public License for more details. 15 | #------------------------------------------------------------------------------ 16 | 17 | use strict; 18 | use warnings; 19 | no warnings qw(uninitialized redefine); 20 | 21 | # Imports 22 | use MwfMain; 23 | 24 | #------------------------------------------------------------------------------ 25 | 26 | # Init 27 | my ($m, $cfg, $lng, $user, $userId) = MwfMain->new($_[0]); 28 | 29 | # Print header 30 | $m->printHeader(); 31 | 32 | # Print page bar 33 | my @navLinks = ({ url => $m->url('forum_show'), txt => 'comUp', ico => 'up' }); 34 | $m->printPageBar(mainTitle => $lng->{hlpTitle}, navLinks => \@navLinks); 35 | 36 | # Replace placeholders in text 37 | my $help = $lng->{help}; 38 | $help =~ s!\[\[dataPath\]\]!$cfg->{dataPath}!g; 39 | 40 | # Print help 41 | print 42 | "
\n", 43 | "
$lng->{hlpTxtTtl}
\n", 44 | "
\n", 45 | $help, 46 | "
\n", 47 | "
\n\n"; 48 | 49 | # Print FAQ 50 | print 51 | "
\n", 52 | "
$lng->{hlpFaqTtl}
\n", 53 | "
\n", 54 | $lng->{faq}, 55 | "
\n", 56 | "
\n\n"; 57 | 58 | # Log action and finish 59 | $m->logAction(3, 'forum', 'help', $userId); 60 | $m->printFooter(); 61 | $m->finish(); 62 | -------------------------------------------------------------------------------- /script/user_unsubscribe.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | #------------------------------------------------------------------------------ 3 | # mwForum - Web-based discussion forum 4 | # Copyright (c) 1999-2015 Markus Wichitill 5 | # 6 | # This program is free software; you can redistribute it and/or modify 7 | # it under the terms of the GNU General Public License as published by 8 | # the Free Software Foundation; either version 3 of the License, or 9 | # (at your option) any later version. 10 | # 11 | # This program is distributed in the hope that it will be useful, 12 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | # GNU General Public License for more details. 15 | #------------------------------------------------------------------------------ 16 | 17 | use strict; 18 | use warnings; 19 | no warnings qw(uninitialized redefine); 20 | 21 | # Imports 22 | use MwfMain; 23 | 24 | #------------------------------------------------------------------------------ 25 | 26 | # Init 27 | my ($m, $cfg, $lng, $user, $userId) = MwfMain->new($_[0]); 28 | 29 | # Get CGI parameters 30 | my $auth = $m->paramStr('t'); 31 | 32 | # Unsubscribe 33 | my $caseSensitive = $m->{mysql} ? 'BINARY' : 'TEXT'; 34 | my ($boardUserId, $boardId) = $m->fetchArray(" 35 | SELECT userId, boardId FROM boardSubscriptions WHERE unsubAuth = CAST(? AS $caseSensitive)", 36 | $auth); 37 | my ($topicUserId, $topicId) = $m->fetchArray(" 38 | SELECT userId, topicId FROM topicSubscriptions WHERE unsubAuth = CAST(? AS $caseSensitive)", 39 | $auth); 40 | if ($boardUserId) { 41 | $m->dbDo(" 42 | DELETE FROM boardSubscriptions WHERE userId = ? AND unsubAuth = CAST(? AS $caseSensitive)", 43 | $boardUserId, $auth); 44 | } 45 | elsif ($topicUserId) { 46 | $m->dbDo(" 47 | DELETE FROM topicSubscriptions WHERE userId = ? AND unsubAuth = CAST(? AS $caseSensitive)", 48 | $topicUserId, $auth); 49 | } 50 | else { 51 | $m->error('errUnsNotFnd'); 52 | } 53 | 54 | # Log action and finish 55 | $m->logAction(1, 'user', 'unsub', $boardUserId || $topicUserId, $boardId, $topicId); 56 | $m->redirect('forum_show', msg => $boardUserId ? 'BrdUnsub' : 'TpcUnsub'); 57 | -------------------------------------------------------------------------------- /script/post_lock.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | #------------------------------------------------------------------------------ 3 | # mwForum - Web-based discussion forum 4 | # Copyright (c) 1999-2015 Markus Wichitill 5 | # 6 | # This program is free software; you can redistribute it and/or modify 7 | # it under the terms of the GNU General Public License as published by 8 | # the Free Software Foundation; either version 3 of the License, or 9 | # (at your option) any later version. 10 | # 11 | # This program is distributed in the hope that it will be useful, 12 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | # GNU General Public License for more details. 15 | #------------------------------------------------------------------------------ 16 | 17 | use strict; 18 | use warnings; 19 | no warnings qw(uninitialized redefine); 20 | 21 | # Imports 22 | use MwfMain; 23 | 24 | #------------------------------------------------------------------------------ 25 | 26 | # Init 27 | my ($m, $cfg, $lng, $user, $userId) = MwfMain->new($_[0]); 28 | 29 | # Get CGI parameters 30 | my $postId = $m->paramInt('pid'); 31 | my $action = $m->paramStrId('act'); 32 | $postId or $m->error('errParamMiss'); 33 | 34 | # Check request source authentication 35 | $m->checkSourceAuth() or $m->error('errSrcAuth'); 36 | 37 | # Get post 38 | my ($boardId, $topicId) = $m->fetchArray(" 39 | SELECT boardId, topicId FROM posts WHERE id = ?", $postId); 40 | $boardId or $m->error('errPstNotFnd'); 41 | 42 | # Get board 43 | my $board = $m->fetchHash(" 44 | SELECT topicAdmins FROM boards WHERE id = ?", $boardId); 45 | 46 | # Check if user is admin or moderator 47 | $user->{admin} || $m->boardAdmin($userId, $boardId) 48 | || $board->{topicAdmins} && $m->topicAdmin($userId, $topicId) 49 | or $m->error('errNoAccess'); 50 | 51 | # Update post 52 | my $locked = $action eq 'lock' ? 1 : 0; 53 | $m->dbDo(" 54 | UPDATE posts SET locked = ? WHERE id = ?", $locked, $postId); 55 | 56 | # Log action and finish 57 | $m->logAction(1, 'post', $locked ? 'lock' : 'unlock', $userId, $boardId, $topicId, $postId); 58 | $m->redirect('topic_show', pid => $postId, msg => $locked ? 'PstLock' : 'PstUnlock'); 59 | -------------------------------------------------------------------------------- /script/topic_lock.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | #------------------------------------------------------------------------------ 3 | # mwForum - Web-based discussion forum 4 | # Copyright (c) 1999-2015 Markus Wichitill 5 | # 6 | # This program is free software; you can redistribute it and/or modify 7 | # it under the terms of the GNU General Public License as published by 8 | # the Free Software Foundation; either version 3 of the License, or 9 | # (at your option) any later version. 10 | # 11 | # This program is distributed in the hope that it will be useful, 12 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | # GNU General Public License for more details. 15 | #------------------------------------------------------------------------------ 16 | 17 | use strict; 18 | use warnings; 19 | no warnings qw(uninitialized redefine); 20 | 21 | # Imports 22 | use MwfMain; 23 | 24 | #------------------------------------------------------------------------------ 25 | 26 | # Init 27 | my ($m, $cfg, $lng, $user, $userId) = MwfMain->new($_[0]); 28 | 29 | # Get CGI parameters 30 | my $topicId = $m->paramInt('tid'); 31 | my $action = $m->paramStrId('act'); 32 | $topicId or $m->error('errParamMiss'); 33 | 34 | # Check request source authentication 35 | $m->checkSourceAuth() or $m->error('errSrcAuth'); 36 | 37 | # Get board id 38 | my $boardId = $m->fetchArray(" 39 | SELECT boardId FROM topics WHERE id = ?", $topicId); 40 | $boardId or $m->error('errTpcNotFnd'); 41 | 42 | # Get board 43 | my $board = $m->fetchHash(" 44 | SELECT topicAdmins FROM boards WHERE id = ?", $boardId); 45 | 46 | # Check if user is admin or moderator 47 | $user->{admin} || $m->boardAdmin($userId, $boardId) 48 | || $board->{topicAdmins} && $m->topicAdmin($userId, $topicId) 49 | or $m->error('errNoAccess'); 50 | 51 | # Lock or unlock 52 | my $locked = $action eq "lock" ? 1 : 0; 53 | 54 | # Update 55 | $m->dbDo(" 56 | UPDATE topics SET locked = ? WHERE id = ?", $locked, $topicId); 57 | 58 | # Log action and finish 59 | $m->logAction(1, 'topic', $locked ? 'lock' : 'unlock', $userId, $boardId, $topicId); 60 | $m->redirect('topic_show', tid => $topicId, msg => $locked ? "TpcLock" : "TpcUnlock"); 61 | -------------------------------------------------------------------------------- /script/group_delete.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | #------------------------------------------------------------------------------ 3 | # mwForum - Web-based discussion forum 4 | # Copyright (c) 1999-2015 Markus Wichitill 5 | # 6 | # This program is free software; you can redistribute it and/or modify 7 | # it under the terms of the GNU General Public License as published by 8 | # the Free Software Foundation; either version 3 of the License, or 9 | # (at your option) any later version. 10 | # 11 | # This program is distributed in the hope that it will be useful, 12 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | # GNU General Public License for more details. 15 | #------------------------------------------------------------------------------ 16 | 17 | use strict; 18 | use warnings; 19 | no warnings qw(uninitialized redefine); 20 | 21 | # Imports 22 | use MwfMain; 23 | 24 | #------------------------------------------------------------------------------ 25 | 26 | # Init 27 | my ($m, $cfg, $lng, $user, $userId) = MwfMain->new($_[0]); 28 | 29 | # Check if user is admin 30 | $user->{admin} or $m->error('errNoAccess'); 31 | 32 | # Get CGI parameters 33 | my $groupId = $m->paramInt('gid'); 34 | $groupId or $m->error('errParamMiss'); 35 | 36 | # Check request source authentication 37 | $m->checkSourceAuth() or $m->error('errSrcAuth'); 38 | 39 | # Delete user badges 40 | $m->dbDo(" 41 | DELETE FROM userBadges 42 | WHERE badge = (SELECT badge FROM groups WHERE id = ?)", $groupId); 43 | 44 | # Delete board moderator permissions 45 | $m->dbDo(" 46 | DELETE FROM boardAdminGroups WHERE groupId = ?", $groupId); 47 | 48 | # Delete board member permissions 49 | $m->dbDo(" 50 | DELETE FROM boardMemberGroups WHERE groupId = ?", $groupId); 51 | 52 | # Delete group admins 53 | $m->dbDo(" 54 | DELETE FROM groupAdmins WHERE groupId = ?", $groupId); 55 | 56 | # Delete group memberships 57 | $m->dbDo(" 58 | DELETE FROM groupMembers WHERE groupId = ?", $groupId); 59 | 60 | # Delete group 61 | $m->dbDo(" 62 | DELETE FROM groups WHERE id = ?", $groupId); 63 | 64 | # Log action and finish 65 | $m->logAction(1, 'group', 'delete', $userId, 0, 0, 0, $groupId); 66 | $m->redirect('group_admin'); 67 | -------------------------------------------------------------------------------- /script/board_delete.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | #------------------------------------------------------------------------------ 3 | # mwForum - Web-based discussion forum 4 | # Copyright (c) 1999-2015 Markus Wichitill 5 | # 6 | # This program is free software; you can redistribute it and/or modify 7 | # it under the terms of the GNU General Public License as published by 8 | # the Free Software Foundation; either version 3 of the License, or 9 | # (at your option) any later version. 10 | # 11 | # This program is distributed in the hope that it will be useful, 12 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | # GNU General Public License for more details. 15 | #------------------------------------------------------------------------------ 16 | 17 | use strict; 18 | use warnings; 19 | no warnings qw(uninitialized redefine); 20 | 21 | # Imports 22 | use MwfMain; 23 | 24 | #------------------------------------------------------------------------------ 25 | 26 | # Init 27 | my ($m, $cfg, $lng, $user, $userId) = MwfMain->new($_[0]); 28 | 29 | # Check if user is admin 30 | $user->{admin} or $m->error('errNoAccess'); 31 | 32 | # Get CGI parameters 33 | my $boardId = $m->paramInt('bid'); 34 | $boardId or $m->error('errParamMiss'); 35 | 36 | # Check request source authentication 37 | $m->checkSourceAuth() or $m->error('errSrcAuth'); 38 | 39 | # Delete admin groups 40 | $m->dbDo(" 41 | DELETE FROM boardAdminGroups WHERE boardId = ?", $boardId); 42 | 43 | # Delete member groups 44 | $m->dbDo(" 45 | DELETE FROM boardMemberGroups WHERE boardId = ?", $boardId); 46 | 47 | # Delete subscriptions 48 | $m->dbDo(" 49 | DELETE FROM boardSubscriptions WHERE boardId = ?", $boardId); 50 | 51 | # Delete hidden-flags 52 | $m->dbDo(" 53 | DELETE FROM boardHiddenFlags WHERE boardId = ?", $boardId); 54 | 55 | # Delete topics 56 | my $topics = $m->fetchAllArray(" 57 | SELECT id FROM topics WHERE boardId = ?", $boardId); 58 | for my $topic (@$topics) { 59 | $m->deleteTopic($topic->[0]); 60 | } 61 | 62 | # Delete board 63 | $m->dbDo(" 64 | DELETE FROM boards WHERE id = ?", $boardId); 65 | 66 | # Log action and finish 67 | $m->logAction(1, 'board', 'delete', $userId, $boardId); 68 | $m->redirect('board_admin'); 69 | -------------------------------------------------------------------------------- /util/util_deleteusers.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | #------------------------------------------------------------------------------ 3 | # mwForum - Web-based discussion forum 4 | # Copyright (c) 1999-2015 Markus Wichitill 5 | # 6 | # This program is free software; you can redistribute it and/or modify 7 | # it under the terms of the GNU General Public License as published by 8 | # the Free Software Foundation; either version 3 of the License, or 9 | # (at your option) any later version. 10 | # 11 | # This program is distributed in the hope that it will be useful, 12 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | # GNU General Public License for more details. 15 | #------------------------------------------------------------------------------ 16 | 17 | # Mass-delete users (and their dependencies) matching a partial SQL query. 18 | 19 | use strict; 20 | use warnings; 21 | no warnings qw(uninitialized); 22 | 23 | # Imports 24 | use Getopt::Std (); 25 | require MwfMain; 26 | 27 | # Get arguments 28 | my %opts = (); 29 | Getopt::Std::getopts('?hxf:', \%opts); 30 | my $help = $opts{'?'} || $opts{h}; 31 | my $execute = $opts{x}; 32 | my $forumId = $opts{f}; 33 | my $sql = $ARGV[0]; 34 | usage() if $help || !length($sql); 35 | 36 | # Init 37 | my ($m, $cfg, $lng) = MwfMain->newShell(forumId => $forumId); 38 | 39 | # Delete users 40 | $m->dbBegin(); 41 | my $users = $m->fetchAllArray(" 42 | SELECT id FROM users WHERE $sql"); 43 | my $sum = 0; 44 | for my $user (@$users) { 45 | $m->deleteUser($user->[0]) if $execute; 46 | $sum++; 47 | } 48 | $m->dbCommit(); 49 | 50 | # Print sum of occurrences 51 | my $verb = $execute ? "Deleted" : "Found"; 52 | print "$verb $sum users\n"; 53 | 54 | #------------------------------------------------------------------------------ 55 | 56 | sub usage 57 | { 58 | print 59 | "\nMass-delete users. Argument is a partial SQL query that defines affected users.\n\n", 60 | "Usage: util_deleteusers.pl [-x] [-f forum] \"email = '' AND lastOnTime < 1199142000\"\n", 61 | " -x Execute deletions. Otherwise, only number of affected users is printed.\n", 62 | " -f Forum hostname or URL path when using a multi-forum installation.\n", 63 | ; 64 | 65 | exit 1; 66 | } 67 | -------------------------------------------------------------------------------- /script/spawn_test.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | #------------------------------------------------------------------------------ 3 | # mwForum - Web-based discussion forum 4 | # Copyright (c) 1999-2015 Markus Wichitill 5 | # 6 | # This program is free software; you can redistribute it and/or modify 7 | # it under the terms of the GNU General Public License as published by 8 | # the Free Software Foundation; either version 3 of the License, or 9 | # (at your option) any later version. 10 | # 11 | # This program is distributed in the hope that it will be useful, 12 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | # GNU General Public License for more details. 15 | #------------------------------------------------------------------------------ 16 | 17 | use strict; 18 | use warnings; 19 | no warnings qw(uninitialized once); 20 | 21 | # Imports 22 | use Getopt::Std (); 23 | use MwfMain; 24 | 25 | #------------------------------------------------------------------------------ 26 | 27 | # Get arguments 28 | my %opts = (); 29 | Getopt::Std::getopts('sf:', \%opts); 30 | my $spawned = $opts{s}; 31 | my $forumId = $opts{f}; 32 | 33 | # Init 34 | my ($m, $cfg, $lng) = MwfMain->newShell(forumId => $forumId, spawned => $spawned, upgrade => 1); 35 | my $output = ""; 36 | $| = 1; 37 | output("mwForum long-running script test running...\n"); 38 | 39 | # Simulate work 40 | output("Pretending to do work that takes 20 minutes...\n"); 41 | for my $minute (1 .. 20) { 42 | output("Sleeping $minute...\n"); 43 | sleep 60; 44 | } 45 | 46 | # Still alive? 47 | output("Nice, the script wasn't interrupted.\n"); 48 | output("mwForum long-running script test done.\n"); 49 | 50 | # Log action 51 | $m->dbDo(" 52 | INSERT INTO log (level, entity, action, logTime, string) VALUES (1, ?, ?, ?)", 53 | 'spawn', 'test', $m->{now}); 54 | 55 | #------------------------------------------------------------------------------ 56 | # Print and collect output 57 | 58 | sub output 59 | { 60 | my $text = shift(); 61 | 62 | print $text; 63 | $output .= $text; 64 | $m->dbDo(" 65 | DELETE FROM variables WHERE name = ?", 'upgOutput'); 66 | $m->dbDo(" 67 | INSERT INTO variables (name, value) VALUES (?, ?)", 'upgOutput', $output); 68 | } 69 | -------------------------------------------------------------------------------- /script/chat_add.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | #------------------------------------------------------------------------------ 3 | # mwForum - Web-based discussion forum 4 | # Copyright (c) 1999-2015 Markus Wichitill 5 | # 6 | # This program is free software; you can redistribute it and/or modify 7 | # it under the terms of the GNU General Public License as published by 8 | # the Free Software Foundation; either version 3 of the License, or 9 | # (at your option) any later version. 10 | # 11 | # This program is distributed in the hope that it will be useful, 12 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | # GNU General Public License for more details. 15 | #------------------------------------------------------------------------------ 16 | 17 | use strict; 18 | use warnings; 19 | no warnings qw(uninitialized redefine); 20 | 21 | # Imports 22 | use MwfMain; 23 | 24 | #------------------------------------------------------------------------------ 25 | 26 | # Init 27 | my ($m, $cfg, $lng, $user, $userId) = MwfMain->new($_[0]); 28 | 29 | # Check if access should be denied 30 | $cfg->{chat} or $m->error('errNoAccess'); 31 | $userId or $m->error('errNoAccess'); 32 | 33 | # Get CGI parameters 34 | my $parentId = $m->paramInt('pid'); 35 | my $body = $m->paramStr('body'); 36 | 37 | # Fake board 38 | my $board = { flat => 1 }; 39 | 40 | # Check request source authentication 41 | $m->checkSourceAuth() or $m->error('errSrcAuth'); 42 | 43 | # Check body length 44 | length($body) or $m->error('errBdyEmpty'); 45 | length($body) <= $cfg->{chatMaxLength} or $m->error('errBdyLen'); 46 | 47 | # Process text 48 | my $chat = { isChat => 1, body => $body }; 49 | $m->editToDb({}, $chat); 50 | 51 | # Any text left after filtering? 52 | length($chat->{body}) or $m->error('errBdyEmpty'); 53 | 54 | # Insert chat message 55 | $m->dbDo(" 56 | INSERT INTO chat (userId, postTime, body) VALUES (?, ?, ?)", 57 | $userId, $m->{now}, $chat->{body}); 58 | my $chatId = $m->dbInsertId("chat"); 59 | 60 | # Expire old messages 61 | $m->dbDo(" 62 | DELETE FROM chat WHERE postTime < ? - ? * 86400", $m->{now}, $cfg->{chatMaxAge}) 63 | if $cfg->{chatMaxAge}; 64 | 65 | # Log action and finish 66 | $m->logAction(1, 'chat', 'add', $userId, 0, 0, 0, $chatId); 67 | $m->redirect('chat_show', msg => 'ChatAdd'); 68 | -------------------------------------------------------------------------------- /util/util_tables2engine.sql: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------- 2 | -- mwForum - Web-based discussion forum 3 | -- Copyright (c) 1999-2015 Markus Wichitill 4 | -- 5 | -- This program is free software; you can redistribute it and/or modify 6 | -- it under the terms of the GNU General Public License as published by 7 | -- the Free Software Foundation; either version 3 of the License, or 8 | -- (at your option) any later version. 9 | -- 10 | -- This program is distributed in the hope that it will be useful, 11 | -- but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | -- GNU General Public License for more details. 14 | ------------------------------------------------------------------------------- 15 | 16 | -- MySQL: convert tables to different engine 17 | ALTER TABLE arc_boards ENGINE = XXXX; 18 | ALTER TABLE arc_topics ENGINE = XXXX; 19 | ALTER TABLE arc_posts ENGINE = XXXX; 20 | ALTER TABLE attachments ENGINE = XXXX; 21 | ALTER TABLE boardAdminGroups ENGINE = XXXX; 22 | ALTER TABLE boardHiddenFlags ENGINE = XXXX; 23 | ALTER TABLE boardMemberGroups ENGINE = XXXX; 24 | ALTER TABLE boards ENGINE = XXXX; 25 | ALTER TABLE boardSubscriptions ENGINE = XXXX; 26 | ALTER TABLE categories ENGINE = XXXX; 27 | ALTER TABLE chat ENGINE = XXXX; 28 | ALTER TABLE config ENGINE = XXXX; 29 | ALTER TABLE groupAdmins ENGINE = XXXX; 30 | ALTER TABLE groupMembers ENGINE = XXXX; 31 | ALTER TABLE groups ENGINE = XXXX; 32 | ALTER TABLE log ENGINE = XXXX; 33 | ALTER TABLE messages ENGINE = XXXX; 34 | ALTER TABLE notes ENGINE = XXXX; 35 | ALTER TABLE pollOptions ENGINE = XXXX; 36 | ALTER TABLE polls ENGINE = XXXX; 37 | ALTER TABLE pollVotes ENGINE = XXXX; 38 | ALTER TABLE postLikes ENGINE = XXXX; 39 | ALTER TABLE postReports ENGINE = XXXX; 40 | ALTER TABLE posts ENGINE = XXXX; 41 | ALTER TABLE tickets ENGINE = XXXX; 42 | ALTER TABLE topicReadTimes ENGINE = XXXX; 43 | ALTER TABLE topics ENGINE = XXXX; 44 | ALTER TABLE topicSubscriptions ENGINE = XXXX; 45 | ALTER TABLE userBadges ENGINE = XXXX; 46 | ALTER TABLE userBans ENGINE = XXXX; 47 | ALTER TABLE userIgnores ENGINE = XXXX; 48 | ALTER TABLE users ENGINE = XXXX; 49 | ALTER TABLE userVariables ENGINE = XXXX; 50 | ALTER TABLE variables ENGINE = XXXX; 51 | ALTER TABLE watchUsers ENGINE = XXXX; 52 | ALTER TABLE watchWords ENGINE = XXXX; 53 | -------------------------------------------------------------------------------- /script/categ_toggle.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | #------------------------------------------------------------------------------ 3 | # mwForum - Web-based discussion forum 4 | # Copyright (c) 1999-2015 Markus Wichitill 5 | # 6 | # This program is free software; you can redistribute it and/or modify 7 | # it under the terms of the GNU General Public License as published by 8 | # the Free Software Foundation; either version 3 of the License, or 9 | # (at your option) any later version. 10 | # 11 | # This program is distributed in the hope that it will be useful, 12 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | # GNU General Public License for more details. 15 | #------------------------------------------------------------------------------ 16 | 17 | use strict; 18 | use warnings; 19 | no warnings qw(uninitialized redefine); 20 | 21 | # Imports 22 | use MwfMain; 23 | 24 | #------------------------------------------------------------------------------ 25 | 26 | # Init 27 | my ($m, $cfg, $lng, $user, $userId) = MwfMain->new($_[0]); 28 | 29 | # Check if access should be denied 30 | $userId or $m->error('errNoAccess'); 31 | 32 | # Get CGI parameters 33 | my $action = $m->paramStrId('act'); 34 | my $categId = $m->paramInt('cid'); 35 | $categId or $m->error('errParamMiss'); 36 | 37 | # Check request source authentication 38 | $m->checkSourceAuth() or $m->error('errSrcAuth'); 39 | 40 | if ($action eq 'hide') { 41 | # Hide all non-hidden boards of category 42 | $m->dbDo(" 43 | INSERT INTO boardHiddenFlags (userId, boardId) 44 | SELECT :userId, id 45 | FROM boards AS boards 46 | LEFT JOIN boardHiddenFlags AS bhf 47 | ON bhf.userId = :userId 48 | AND bhf.boardId = boards.id 49 | WHERE boards.categoryId = :categId 50 | AND bhf.userId IS NULL", 51 | { userId => $userId, categId => $categId }); 52 | 53 | # Log action and finish 54 | $m->logAction(1, 'categ', 'hide', $userId, 0, 0, 0, $categId); 55 | $m->redirect('forum_show'); 56 | } 57 | elsif ($action eq 'show') { 58 | # Show all boards of category, except manually hidden ones 59 | $m->dbDo(" 60 | DELETE FROM boardHiddenFlags 61 | WHERE userId = ? 62 | AND boardId IN (SELECT id FROM boards WHERE categoryId = ?) 63 | AND manual = 0", 64 | $userId, $categId); 65 | 66 | # Log action and finish 67 | $m->logAction(1, 'categ', 'show', $userId, 0, 0, 0, $categId); 68 | $m->redirect('forum_show'); 69 | } 70 | -------------------------------------------------------------------------------- /script/forum_feeds.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | #------------------------------------------------------------------------------ 3 | # mwForum - Web-based discussion forum 4 | # Copyright (c) 1999-2015 Markus Wichitill 5 | # 6 | # This program is free software; you can redistribute it and/or modify 7 | # it under the terms of the GNU General Public License as published by 8 | # the Free Software Foundation; either version 3 of the License, or 9 | # (at your option) any later version. 10 | # 11 | # This program is distributed in the hope that it will be useful, 12 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | # GNU General Public License for more details. 15 | #------------------------------------------------------------------------------ 16 | 17 | use strict; 18 | use warnings; 19 | no warnings qw(uninitialized redefine); 20 | 21 | # Imports 22 | use MwfMain; 23 | 24 | #------------------------------------------------------------------------------ 25 | 26 | # Init 27 | my ($m, $cfg, $lng, $user, $userId) = MwfMain->new($_[0]); 28 | 29 | # Print header 30 | $m->printHeader(); 31 | 32 | # Print page bar 33 | my @navLinks = ({ url => $m->url('forum_show'), txt => 'comUp', ico => 'up' }); 34 | $m->printPageBar(mainTitle => $lng->{fedTitle}, navLinks => \@navLinks); 35 | 36 | # Get boards 37 | my $boards = $m->fetchAllHash(" 38 | SELECT boards.id, boards.title, 39 | categories.title AS categTitle 40 | FROM boards AS boards 41 | INNER JOIN categories AS categories 42 | ON categories.id = boards.categoryId 43 | WHERE boards.private = 0 44 | ORDER BY categories.pos, boards.pos"); 45 | 46 | # Print feed list 47 | my $path = "$cfg->{attachUrlPath}/xml"; 48 | print 49 | "\n", 50 | "\n", 51 | "\n", 52 | "\n", 53 | "\n", 54 | "\n"; 55 | 56 | for my $board (@$boards) { 57 | print 58 | "\n", 59 | "\n", 60 | "\n", 61 | "\n", 62 | "\n"; 63 | } 64 | 65 | print 66 | "
$lng->{fedAllBoards}Atom 1.0RSS 2.0
$board->{categTitle} / $board->{title}Atom 1.0RSS 2.0
\n"; 67 | 68 | # Log action and finish 69 | $m->logAction(3, 'forum', 'feeds', $userId); 70 | $m->printFooter(); 71 | $m->finish(); 72 | -------------------------------------------------------------------------------- /util/util_citext.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | #------------------------------------------------------------------------------ 3 | # mwForum - Web-based discussion forum 4 | # Copyright (c) 1999-2015 Markus Wichitill 5 | # 6 | # This program is free software; you can redistribute it and/or modify 7 | # it under the terms of the GNU General Public License as published by 8 | # the Free Software Foundation; either version 3 of the License, or 9 | # (at your option) any later version. 10 | # 11 | # This program is distributed in the hope that it will be useful, 12 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | # GNU General Public License for more details. 15 | #------------------------------------------------------------------------------ 16 | 17 | # Change data type of VARCHAR/TEXT columns to citext in PgSQL databases. 18 | 19 | use strict; 20 | use warnings; 21 | no warnings qw(uninitialized once); 22 | 23 | # Imports 24 | use Getopt::Std (); 25 | require MwfMain; 26 | 27 | # Get arguments 28 | my %opts = (); 29 | Getopt::Std::getopts('?hf:', \%opts); 30 | my $help = $opts{'?'} || $opts{h}; 31 | my $forumId = $opts{f}; 32 | usage() if $help; 33 | 34 | # Init 35 | my ($m, $cfg, $lng) = MwfMain->newShell(forumId => $forumId); 36 | 37 | # Check if PgSQL 38 | $cfg->{dbDriver} eq 'Pg' or $m->error("This script is for PgSQL only."); 39 | 40 | # Get columns 41 | my $tablesStr = join(", ", map("'".lc($_)."'", @MwfDefaults::tables, @MwfDefaults::arcTables)); 42 | my $columns = $m->fetchAllHash(" 43 | SELECT table_name, column_name 44 | FROM information_schema.columns 45 | WHERE table_schema = :schema 46 | AND table_name IN ($tablesStr) 47 | AND (data_type = 'character varying' OR data_type = 'text') 48 | AND character_maximum_length <> 22 49 | ORDER BY table_name", 50 | { schema => $cfg->{dbSchema} || 'public' } ); 51 | 52 | # Change data type to citext 53 | for my $col (@$columns) { 54 | print "ALTER TABLE $col->{table_name} ALTER $col->{column_name} TYPE citext\n"; 55 | $m->dbDo("ALTER TABLE $col->{table_name} ALTER $col->{column_name} TYPE citext"); 56 | } 57 | 58 | #------------------------------------------------------------------------------ 59 | 60 | sub usage 61 | { 62 | print 63 | "\nChange data type of VARCHAR/TEXT columns to citext in PgSQL databases.\n\n", 64 | "Usage: util_citext.pl [-f forum]\n", 65 | " -f Forum hostname or URL path when using a multi-forum installation.\n", 66 | ; 67 | 68 | exit 1; 69 | } 70 | -------------------------------------------------------------------------------- /script/post_like.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | #------------------------------------------------------------------------------ 3 | # mwForum - Web-based discussion forum 4 | # Copyright (c) 1999-2015 Markus Wichitill 5 | # 6 | # This program is free software; you can redistribute it and/or modify 7 | # it under the terms of the GNU General Public License as published by 8 | # the Free Software Foundation; either version 3 of the License, or 9 | # (at your option) any later version. 10 | # 11 | # This program is distributed in the hope that it will be useful, 12 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | # GNU General Public License for more details. 15 | #------------------------------------------------------------------------------ 16 | 17 | use strict; 18 | use warnings; 19 | no warnings qw(uninitialized redefine); 20 | 21 | # Imports 22 | use MwfMain; 23 | 24 | #------------------------------------------------------------------------------ 25 | 26 | # Init 27 | my ($m, $cfg, $lng, $user, $userId) = MwfMain->new($_[0]); 28 | 29 | # Check if access should be denied 30 | $userId or $m->error('errNoAccess'); 31 | $cfg->{postLikes} or $m->error('errNoAccess'); 32 | 33 | # Get CGI parameters 34 | my $postId = $m->paramInt('pid'); 35 | my $action = $m->paramStrId('act'); 36 | $postId or $m->error('errParamMiss'); 37 | 38 | # Check request source authentication 39 | $m->checkSourceAuth() or $m->error('errSrcAuth'); 40 | 41 | # Get post 42 | my ($boardId, $topicId, $postUserId) = $m->fetchArray(" 43 | SELECT boardId, topicId, userId FROM posts WHERE id = ?", $postId); 44 | $boardId or $m->error('errPstNotFnd'); 45 | 46 | # No liking own posts 47 | $userId != $postUserId or $m->error('errNoAccess'); 48 | 49 | # Check if already liked 50 | my $liked = $m->fetchArray(" 51 | SELECT 1 FROM postLikes WHERE postId = ? AND userId = ?", $postId, $userId); 52 | 53 | # Add like or revoke like 54 | my $like = $action eq 'like' ? 1 : 0; 55 | if ($like && !$liked) { 56 | # Insert like 57 | $m->dbDo(" 58 | INSERT INTO postLikes (postId, userId) VALUES (?, ?)", $postId, $userId); 59 | } 60 | elsif (!$like && $liked) { 61 | # Remove like 62 | $m->dbDo(" 63 | DELETE FROM postLikes WHERE postId = ? AND userId = ?", $postId, $userId); 64 | } 65 | 66 | # Log action and finish 67 | $m->logAction(1, 'post', $like ? 'like' : 'unlike', $userId, $boardId, $topicId, $postId); 68 | $m->redirect('topic_show', pid => $postId, msg => $like ? 'PstLike' : 'PstUnlike'); 69 | -------------------------------------------------------------------------------- /example/MwfPlgAuthz.pm: -------------------------------------------------------------------------------- 1 | #------------------------------------------------------------------------------ 2 | # mwForum - Web-based discussion forum 3 | # Copyright © 1999-2015 Markus Wichitill 4 | # 5 | # This program is free software; you can redistribute it and/or modify 6 | # it under the terms of the GNU General Public License as published by 7 | # the Free Software Foundation; either version 3 of the License, or 8 | # (at your option) any later version. 9 | # 10 | # This program is distributed in the hope that it will be useful, 11 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | # GNU General Public License for more details. 14 | #------------------------------------------------------------------------------ 15 | 16 | package MwfPlgAuthz; 17 | use utf8; 18 | use strict; 19 | use warnings; 20 | no warnings qw(uninitialized redefine); 21 | our $VERSION = "2.27.0"; 22 | 23 | #------------------------------------------------------------------------------ 24 | # Parameters for all actions: 25 | # m => MwfMain object 26 | # 27 | # Additional parameters for action 'viewBoard': 28 | # user => user hashref 29 | # board => board hashref 30 | # 31 | # Return undef to authorize the action, any error message string to deny it. 32 | # Exception for viewBoard: return undef to continue normal access checking, 33 | # 1 to deny, and 2 to grant access without further access checking. 34 | 35 | #------------------------------------------------------------------------------ 36 | # This simple user registration example checks a code in the extra3 profile field 37 | # and allows registration if the code is 42. 38 | 39 | sub regUser 40 | { 41 | my %params = @_; 42 | my $m = $params{m}; 43 | 44 | return undef if $m->paramInt('extra3') == 42; 45 | return "Invalid code"; 46 | } 47 | 48 | #------------------------------------------------------------------------------ 49 | # This simple view-board example checks if the user paid his fees for a 50 | # specific board. $user->{paid} would have to be created and updated by the 51 | # adaptor code of an external payment system. 52 | 53 | sub viewBoard 54 | { 55 | my %params = @_; 56 | my $m = $params{m}; 57 | my $user = $params{user}; 58 | my $board = $params{board}; 59 | 60 | return undef if $board->{id} != 6; # Ok, not a pay board 61 | return undef if $user->{paid}; # Ok, user paid his bills 62 | return 1; # Deny 63 | } 64 | 65 | #------------------------------------------------------------------------------ 66 | 1; 67 | -------------------------------------------------------------------------------- /data/google.js: -------------------------------------------------------------------------------- 1 | /*jslint browser: true, onevar: true, undef: true, nomen: true, eqeqeq: true, 2 | plusplus: true, bitwise: true, regexp: true, newcap: true, immed: true */ 3 | /*global $, window, document, navigator, google, mwf */ 4 | 5 | /* mwForum - Web-based discussion forum | Copyright 1999-2015 Markus Wichitill */ 6 | 7 | mwf.initGoogleMaps = function () { 8 | var map, viewport, geocoder, 9 | markers = []; 10 | if (!mwf.p.location) { return; } 11 | geocoder = new google.maps.Geocoder(); 12 | geocoder.geocode({ address: mwf.p.location, country: mwf.p.countryCode, 13 | language: mwf.p.uaLangCode }, function (results, status) { 14 | var txt, i, result, 15 | mapOb = $("#map"); 16 | if (status !== google.maps.GeocoderStatus.OK) { 17 | mapOb.closest(".frm").hide(); 18 | return; 19 | } 20 | viewport = results[0].geometry.viewport; 21 | if (mwf.p.location.match(/^[\s\d\.\-]+$/)) { results = results.slice(0, 1); } 22 | if (results[0].formatted_address) { 23 | txt = results[0].formatted_address; 24 | if (results.length > 1) { 25 | txt += " (" + (results.length - 1) + " " + mwf.p.lng_uifMapOthrMt + ")"; 26 | } 27 | $("#loc").append(txt); 28 | } 29 | map = new google.maps.Map(mapOb[0], { mapTypeId: google.maps.MapTypeId.ROADMAP, 30 | center: results[0].geometry.location, zoom: 4 }); 31 | for (i = 0; (result = results[i]); i += 1) { 32 | markers.push(new google.maps.Marker({ map: map, position: result.geometry.location, 33 | title: result.formatted_address + " [" + result.geometry.location_type + "]" })); 34 | } 35 | } 36 | ); 37 | $("#loc").on("click", function () { map.fitBounds(viewport); }); 38 | }; 39 | 40 | mwf.initAgentCharts = function () { 41 | mwf.showAgentChart("ua", $("#uaPie").data("array")); 42 | mwf.showAgentChart("os", $("#osPie").data("array")); 43 | }; 44 | 45 | mwf.showAgentChart = function(id, array) { 46 | var data = new google.visualization.arrayToDataTable(array, true), 47 | chart = new google.visualization.PieChart($("#" + id + "Pie")[0]); 48 | chart.draw(data, { 49 | width: 250, height: 200, is3D: true, backgroundColor: "transparent", 50 | legend: "none", pieSliceText: "label", pieSliceTextStyle: { color: "black" }, 51 | chartArea: { left: 0, top: 0, width: "100%", height: "100%" } 52 | }); 53 | }; 54 | 55 | mwf.initCountryChart = function () { 56 | var array = $("#map").data("array"), 57 | data = new google.visualization.arrayToDataTable(array, true), 58 | chart = new google.visualization.GeoChart($("#map")[0]); 59 | chart.draw(data, { backgroundColor: "transparent", legend: "none" }); 60 | }; 61 | -------------------------------------------------------------------------------- /script/ajax_check.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | #------------------------------------------------------------------------------ 3 | # mwForum - Web-based discussion forum 4 | # Copyright (c) 1999-2015 Markus Wichitill 5 | # 6 | # This program is free software; you can redistribute it and/or modify 7 | # it under the terms of the GNU General Public License as published by 8 | # the Free Software Foundation; either version 3 of the License, or 9 | # (at your option) any later version. 10 | # 11 | # This program is distributed in the hope that it will be useful, 12 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | # GNU General Public License for more details. 15 | #------------------------------------------------------------------------------ 16 | 17 | use strict; 18 | use warnings; 19 | no warnings qw(uninitialized redefine); 20 | 21 | # Imports 22 | use MwfMain; 23 | 24 | #------------------------------------------------------------------------------ 25 | 26 | # Init 27 | my ($m, $cfg, $lng, $user, $userId) = MwfMain->new($_[0], ajax => 1); 28 | 29 | # Print header 30 | $m->printHttpHeader(); 31 | 32 | # Get CGI parameters 33 | my $action = $m->paramStrId('act'); 34 | 35 | if ($action eq 'cookie') { 36 | # Get and delete checking cookie 37 | my $ok = $m->getCookie('check') ? 1 : 0; 38 | $m->deleteCookie('check'); 39 | 40 | # Answer in JSON 41 | print $m->json({ ok => $ok }); 42 | 43 | # Log action and commit 44 | $m->logAction(3, 'ajax', 'ckcookie'); 45 | $m->finish(); 46 | } 47 | elsif ($action eq 'userName') { 48 | # Check username for validity 49 | my $userName = $m->paramStr('name'); 50 | my $errStr = ""; 51 | if (length($userName) == 0) { 52 | $errStr = $lng->{errNamEmpty}; 53 | } 54 | elsif (length($userName) < 2 || length($userName) > $cfg->{maxUserNameLen}) { 55 | $errStr = $lng->{errNamSize}; 56 | } 57 | elsif ($userName =~ /\s{2,}/ || $userName =~ /https?:/ || $userName !~ /$cfg->{userNameRegExp}/) { 58 | $errStr = $lng->{errNamChar}; 59 | } 60 | elsif (grep(index(lc($userName), lc($_)) > -1, @{$cfg->{reservedNames}})) { 61 | $errStr = $lng->{errNamResrvd}; 62 | } 63 | elsif ($m->fetchArray("SELECT id FROM users WHERE userName = ?", $userName)) { 64 | $errStr = $lng->{errNamGone}; 65 | } 66 | 67 | # Answer in JSON 68 | chop($errStr) if substr($errStr, -1) eq "."; 69 | print $errStr ? $m->json({ error => $errStr }) : $m->json({ ok => 1 }); 70 | 71 | # Log action and commit 72 | $m->logAction(3, 'ajax', 'ckname', $userId, 0, 0, 0, 0, $m->escHtml($userName)); 73 | $m->finish(); 74 | } 75 | -------------------------------------------------------------------------------- /script/post_approve.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | #------------------------------------------------------------------------------ 3 | # mwForum - Web-based discussion forum 4 | # Copyright (c) 1999-2015 Markus Wichitill 5 | # 6 | # This program is free software; you can redistribute it and/or modify 7 | # it under the terms of the GNU General Public License as published by 8 | # the Free Software Foundation; either version 3 of the License, or 9 | # (at your option) any later version. 10 | # 11 | # This program is distributed in the hope that it will be useful, 12 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | # GNU General Public License for more details. 15 | #------------------------------------------------------------------------------ 16 | 17 | use strict; 18 | use warnings; 19 | no warnings qw(uninitialized redefine); 20 | 21 | # Imports 22 | use MwfMain; 23 | 24 | #------------------------------------------------------------------------------ 25 | 26 | # Init 27 | my ($m, $cfg, $lng, $user, $userId) = MwfMain->new($_[0]); 28 | 29 | # Get CGI parameters 30 | my $postId = $m->paramInt('pid'); 31 | $postId or $m->error('errParamMiss'); 32 | 33 | # Check request source authentication 34 | $m->checkSourceAuth() or $m->error('errSrcAuth'); 35 | 36 | # Get post 37 | my $post = $m->fetchHash(" 38 | SELECT * FROM posts WHERE id = ?", $postId); 39 | $post or $m->error('errPstNotFnd'); 40 | my $boardId = $post->{boardId}; 41 | my $topicId = $post->{topicId}; 42 | 43 | # Get parent post 44 | my $parent = undef; 45 | $parent = $m->fetchHash(" 46 | SELECT * FROM posts WHERE id = ?", $post->{parentId}) 47 | if $post->{parentId}; 48 | 49 | # Get board 50 | my $board = $m->fetchHash(" 51 | SELECT * FROM boards WHERE id = ?", $boardId); 52 | $board or $m->error('errBrdNotFnd'); 53 | 54 | # Get topic 55 | my $topic = $m->fetchHash(" 56 | SELECT * FROM topics WHERE id = ?", $topicId); 57 | $topic or $m->error('errTpcNotFnd'); 58 | 59 | # Check if user is admin or moderator 60 | $user->{admin} || $m->boardAdmin($userId, $boardId) 61 | || $board->{topicAdmins} && $m->topicAdmin($userId, $topicId) 62 | or $m->error('errNoAccess'); 63 | 64 | # Update post 65 | $m->dbDo(" 66 | UPDATE posts SET approved = 1 WHERE id = ?", $postId); 67 | 68 | # Send delayed notifications 69 | $m->notifyPost(board => $board, topic => $topic, post => $post, parent => $parent); 70 | 71 | # Log action and finish 72 | $m->logAction(1, 'post', 'approve', $userId, $boardId, $topicId, $postId); 73 | $m->redirect('topic_show', pid => $postId, msg => 'PstApprv'); 74 | -------------------------------------------------------------------------------- /script/MwfConfigDefault.pm: -------------------------------------------------------------------------------- 1 | package MwfConfig; 2 | use strict; 3 | use warnings; 4 | our ($VERSION, $cfg); 5 | $VERSION = "2.27.4"; 6 | 7 | #----------------------------------------------------------------------------- 8 | # Basic options 9 | # The following options are required by the forum before it can load the 10 | # rest of the configuration from the database. 11 | 12 | # Base URL without path (no trailing /) 13 | $cfg->{baseUrl} = "http://www.example.com"; 14 | 15 | # URL path to data directory (no trailing /) 16 | $cfg->{dataPath} = "/mwf"; 17 | 18 | # Database server host 19 | $cfg->{dbServer} = "localhost"; 20 | 21 | # Database name 22 | $cfg->{dbName} = "mwforum"; 23 | 24 | # Database user 25 | $cfg->{dbUser} = "mwforum"; 26 | 27 | # Database password 28 | $cfg->{dbPassword} = "password"; 29 | 30 | # Database table name prefix in MySQL (usually not required) 31 | $cfg->{dbPrefix} = ""; 32 | 33 | # DBI driver. Either "mysql", "Pg" or "SQLite". 34 | $cfg->{dbDriver} = "mysql"; 35 | 36 | # Additional DBI parameters (usually not required) 37 | # Example: "port=321;mysql_socket=/tmp/mysql.sock" 38 | $cfg->{dbParam} = ""; 39 | 40 | # Max. size of attachments 41 | # Also limits general CGI input. Don't set it below a few thousand byte. 42 | $cfg->{maxAttachLen} = 1048576; 43 | 44 | #----------------------------------------------------------------------------- 45 | # The following options can only be changed here and not in the online form 46 | # for security reasons. 47 | 48 | # Sendmail executable and options (only required for sendmail mailer) 49 | $cfg->{sendmail} = "/usr/sbin/sendmail -oi -oeq -t"; 50 | 51 | # Filesystem path of the attachment directory (no trailing /) 52 | $cfg->{attachFsPath} = ""; 53 | 54 | # Filesystem path of the script directory (no trailing /) 55 | # Required for cron emu, manual cron starting and instant subscriptions 56 | # Example: "/usr/local/apache/cgi-bin/mwf" 57 | $cfg->{scriptFsPath} = ""; 58 | 59 | # Filesystem path of the Perl interpreter 60 | # Required for cron emu, manual cron starting and instant subscriptions 61 | $cfg->{perlBinary} = "/usr/bin/perl"; 62 | 63 | # Limit forum options and details pages to certain admins, otherwise 64 | # all admins have access 65 | # Comma-sep. list of numeric user IDs, example: "1,2,3" 66 | $cfg->{cfgAdmins} = ""; 67 | 68 | # Log errors/warnings into this file in addition to the webserver log 69 | # Example: "/var/log/forum.log" 70 | $cfg->{errorLog} = ""; 71 | 72 | #------------------------------------------------------------------------------ 73 | # Other options go here 74 | 75 | 76 | #----------------------------------------------------------------------------- 77 | # Return OK 78 | 1; 79 | -------------------------------------------------------------------------------- /util/util_text2medium.sql: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------- 2 | -- mwForum - Web-based discussion forum 3 | -- Copyright (c) 1999-2015 Markus Wichitill 4 | -- 5 | -- This program is free software; you can redistribute it and/or modify 6 | -- it under the terms of the GNU General Public License as published by 7 | -- the Free Software Foundation; either version 3 of the License, or 8 | -- (at your option) any later version. 9 | -- 10 | -- This program is distributed in the hope that it will be useful, 11 | -- but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | -- GNU General Public License for more details. 14 | ------------------------------------------------------------------------------- 15 | 16 | -- MySQL: make text fields accept > 64k 17 | ALTER TABLE arc_boards MODIFY longDesc MEDIUMTEXT NOT NULL DEFAULT ''; 18 | ALTER TABLE arc_posts MODIFY body MEDIUMTEXT NOT NULL; 19 | ALTER TABLE arc_posts MODIFY rawBody MEDIUMTEXT NOT NULL DEFAULT ''; 20 | ALTER TABLE arc_topics MODIFY subject MEDIUMTEXT NOT NULL; 21 | ALTER TABLE boards MODIFY longDesc MEDIUMTEXT NOT NULL DEFAULT ''; 22 | ALTER TABLE chat MODIFY body MEDIUMTEXT NOT NULL; 23 | ALTER TABLE config MODIFY value MEDIUMTEXT NOT NULL DEFAULT ''; 24 | ALTER TABLE log MODIFY string MEDIUMTEXT NOT NULL DEFAULT ''; 25 | ALTER TABLE messages MODIFY body MEDIUMTEXT NOT NULL; 26 | ALTER TABLE messages MODIFY subject MEDIUMTEXT NOT NULL; 27 | ALTER TABLE notes MODIFY body MEDIUMTEXT NOT NULL; 28 | ALTER TABLE pollOptions MODIFY title MEDIUMTEXT NOT NULL; 29 | ALTER TABLE polls MODIFY title MEDIUMTEXT NOT NULL; 30 | ALTER TABLE postReports MODIFY reason MEDIUMTEXT NOT NULL; 31 | ALTER TABLE posts MODIFY body MEDIUMTEXT NOT NULL; 32 | ALTER TABLE posts MODIFY rawBody MEDIUMTEXT NOT NULL DEFAULT ''; 33 | ALTER TABLE topics MODIFY subject MEDIUMTEXT NOT NULL; 34 | ALTER TABLE userBans MODIFY intReason MEDIUMTEXT NOT NULL DEFAULT ''; 35 | ALTER TABLE userBans MODIFY reason MEDIUMTEXT NOT NULL DEFAULT ''; 36 | ALTER TABLE users MODIFY title MEDIUMTEXT NOT NULL DEFAULT ''; 37 | ALTER TABLE users MODIFY signature MEDIUMTEXT NOT NULL DEFAULT ''; 38 | ALTER TABLE users MODIFY blurb MEDIUMTEXT NOT NULL DEFAULT ''; 39 | ALTER TABLE users MODIFY extra1 MEDIUMTEXT NOT NULL DEFAULT ''; 40 | ALTER TABLE users MODIFY extra2 MEDIUMTEXT NOT NULL DEFAULT ''; 41 | ALTER TABLE users MODIFY extra3 MEDIUMTEXT NOT NULL DEFAULT ''; 42 | ALTER TABLE users MODIFY oldNames MEDIUMTEXT NOT NULL DEFAULT ''; 43 | ALTER TABLE users MODIFY comment MEDIUMTEXT NOT NULL DEFAULT ''; 44 | ALTER TABLE userVariables MODIFY value MEDIUMTEXT NOT NULL DEFAULT ''; 45 | ALTER TABLE variables MODIFY value MEDIUMTEXT NOT NULL DEFAULT ''; 46 | -------------------------------------------------------------------------------- /script/categ_admin.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | #------------------------------------------------------------------------------ 3 | # mwForum - Web-based discussion forum 4 | # Copyright (c) 1999-2015 Markus Wichitill 5 | # 6 | # This program is free software; you can redistribute it and/or modify 7 | # it under the terms of the GNU General Public License as published by 8 | # the Free Software Foundation; either version 3 of the License, or 9 | # (at your option) any later version. 10 | # 11 | # This program is distributed in the hope that it will be useful, 12 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | # GNU General Public License for more details. 15 | #------------------------------------------------------------------------------ 16 | 17 | use strict; 18 | use warnings; 19 | no warnings qw(uninitialized redefine); 20 | 21 | # Imports 22 | use MwfMain; 23 | 24 | #------------------------------------------------------------------------------ 25 | 26 | # Init 27 | my ($m, $cfg, $lng, $user, $userId) = MwfMain->new($_[0]); 28 | 29 | # Check if user is admin 30 | $user->{admin} or $m->error('errNoAccess'); 31 | 32 | # Print header 33 | $m->printHeader(); 34 | 35 | # Print page bar 36 | my @navLinks = ({ url => $m->url('forum_show'), txt => 'comUp', ico => 'up' }); 37 | $m->printPageBar(mainTitle => "Category Administration", navLinks => \@navLinks); 38 | 39 | # Print create category form 40 | print 41 | "
\n", 42 | "
\n", 43 | "
Create Category
\n", 44 | "
\n", 45 | $m->submitButton("Create", 'category'), 46 | $m->stdFormFields(), 47 | "
\n", 48 | "
\n", 49 | "
\n\n"; 50 | 51 | # Get categories 52 | my $categs = $m->fetchAllHash(" 53 | SELECT * FROM categories ORDER BY pos"); 54 | 55 | # Print category list 56 | print 57 | "\n", 58 | "\n", 59 | "\n"; 60 | 61 | for my $categ (@$categs) { 62 | my $optUrl = $m->url('categ_options', cid => $categ->{id}); 63 | my $delUrl = $m->url('user_confirm', cid => $categ->{id}, script => 'categ_delete', 64 | name => $categ->{title}); 65 | print 66 | "\n", 67 | "\n", 68 | "\n", 69 | "\n", 73 | "\n"; 74 | } 75 | 76 | print "
TitlePositionCommands
$categ->{title}$categ->{pos}\n", 70 | "Options\n", 71 | "Delete\n", 72 | "
\n\n"; 77 | 78 | # Log action and finish 79 | $m->logAction(3, 'categ', 'admin', $userId); 80 | $m->printFooter(); 81 | $m->finish(); 82 | -------------------------------------------------------------------------------- /script/branch_delete.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | #------------------------------------------------------------------------------ 3 | # mwForum - Web-based discussion forum 4 | # Copyright (c) 1999-2015 Markus Wichitill 5 | # 6 | # This program is free software; you can redistribute it and/or modify 7 | # it under the terms of the GNU General Public License as published by 8 | # the Free Software Foundation; either version 3 of the License, or 9 | # (at your option) any later version. 10 | # 11 | # This program is distributed in the hope that it will be useful, 12 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | # GNU General Public License for more details. 15 | #------------------------------------------------------------------------------ 16 | 17 | use strict; 18 | use warnings; 19 | no warnings qw(uninitialized redefine); 20 | 21 | # Imports 22 | use MwfMain; 23 | 24 | #------------------------------------------------------------------------------ 25 | 26 | # Init 27 | my ($m, $cfg, $lng, $user, $userId) = MwfMain->new($_[0]); 28 | 29 | # Get CGI parameters 30 | my $postId = $m->paramInt('pid'); 31 | $postId or $m->error('errParamMiss'); 32 | 33 | # Check request source authentication 34 | $m->checkSourceAuth() or $m->error('errSrcAuth'); 35 | 36 | # Get branch base post 37 | my ($boardId, $topicId, $parentId) = $m->fetchArray(" 38 | SELECT boardId, topicId, parentId FROM posts WHERE id = ?", $postId); 39 | $boardId or $m->error('errPstNotFnd'); 40 | 41 | # Get board 42 | my $board = $m->fetchHash(" 43 | SELECT topicAdmins FROM boards WHERE id = ?", $boardId); 44 | 45 | # Get topic base post 46 | my $basePostId = $m->fetchArray(" 47 | SELECT basePostId FROM topics WHERE id = ?", $topicId); 48 | $basePostId != $postId or $m->error('errPromoTpc'); 49 | 50 | # Check if user is admin or moderator 51 | $user->{admin} || $m->boardAdmin($userId, $boardId) 52 | || $board->{topicAdmins} && $m->topicAdmin($userId, $topicId) 53 | or $m->error('errNoAccess'); 54 | 55 | # Get posts 56 | my $posts = $m->fetchAllHash(" 57 | SELECT id, parentId FROM posts WHERE topicId = ?", $topicId); 58 | 59 | # Put posts in by-parent lookup table 60 | my %postsByParent = (); 61 | push @{$postsByParent{$_->{parentId}}}, $_ for @$posts; 62 | 63 | # Delete posts 64 | my $deleteBranch = sub { 65 | my $self = shift(); 66 | my $pid = shift(); 67 | 68 | # Recurse through children 69 | for my $child (@{$postsByParent{$pid}}) { 70 | $child->{id} != $pid or $m->error("Post is its own parent?!"); 71 | $self->($self, $child->{id}); 72 | } 73 | 74 | # Delete post 75 | $m->deletePost($pid, 0, 0, 0); 76 | }; 77 | $deleteBranch->($deleteBranch, $postId); 78 | $m->recalcStats($boardId, $topicId); 79 | 80 | # Log action and finish 81 | $m->logAction(1, 'branch', 'delete', $userId, $boardId, $topicId, $postId); 82 | $m->redirect('topic_show', tid => $topicId, msg => 'BrnDelete'); 83 | -------------------------------------------------------------------------------- /script/poll_delete.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | #------------------------------------------------------------------------------ 3 | # mwForum - Web-based discussion forum 4 | # Copyright (c) 1999-2015 Markus Wichitill 5 | # 6 | # This program is free software; you can redistribute it and/or modify 7 | # it under the terms of the GNU General Public License as published by 8 | # the Free Software Foundation; either version 3 of the License, or 9 | # (at your option) any later version. 10 | # 11 | # This program is distributed in the hope that it will be useful, 12 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | # GNU General Public License for more details. 15 | #------------------------------------------------------------------------------ 16 | 17 | use strict; 18 | use warnings; 19 | no warnings qw(uninitialized redefine); 20 | 21 | # Imports 22 | use MwfMain; 23 | 24 | #------------------------------------------------------------------------------ 25 | 26 | # Init 27 | my ($m, $cfg, $lng, $user, $userId) = MwfMain->new($_[0]); 28 | 29 | # Get CGI parameters 30 | my $topicId = $m->paramInt('tid'); 31 | 32 | # Check request source authentication 33 | $m->checkSourceAuth() or $m->error('errSrcAuth'); 34 | 35 | # Get topic 36 | my ($boardId, $pollId, $topicUserId) = $m->fetchArray(" 37 | SELECT topics.boardId, topics.pollId, posts.userId 38 | FROM topics AS topics 39 | INNER JOIN posts AS posts 40 | ON posts.id = topics.basePostId 41 | WHERE topics.id = ?", $topicId); 42 | $boardId or $m->error('errTpcNotFnd'); 43 | 44 | # Get board 45 | my $board = $m->fetchHash(" 46 | SELECT * FROM boards WHERE id = ?", $boardId); 47 | $board or $m->error('errBrdNotFnd'); 48 | 49 | # Check if user can see and write to board 50 | my $boardAdmin = $user->{admin} || $m->boardAdmin($userId, $boardId) 51 | || $board->{topicAdmins} && $m->topicAdmin($userId, $topicId); 52 | $boardAdmin || $m->boardVisible($board) or $m->error('errNoAccess'); 53 | $boardAdmin || $m->boardWritable($board, 1) or $m->error('errNoAccess'); 54 | 55 | # Check if user owns topic or is moderator 56 | $userId == $topicUserId || $boardAdmin or $m->error('errNoAccess'); 57 | 58 | # Normal topic creator may only delete if there have been no votes so far 59 | if (!$boardAdmin) { 60 | !$m->fetchArray(" 61 | SELECT pollId FROM pollVotes WHERE pollId = ?", $pollId) 62 | or $m->error('errPolNoDel'); 63 | } 64 | 65 | # Delete poll 66 | $m->dbDo(" 67 | DELETE FROM pollVotes WHERE pollId = ?", $pollId); 68 | $m->dbDo(" 69 | DELETE FROM pollOptions WHERE pollId = ?", $pollId); 70 | $m->dbDo(" 71 | DELETE FROM polls WHERE id = ?", $pollId); 72 | $m->dbDo(" 73 | UPDATE topics SET pollId = 0 WHERE id = ?", $topicId); 74 | 75 | # Log action and finish 76 | $m->logAction(1, 'poll', 'delete', $userId, $boardId, $topicId, undef, $pollId); 77 | $m->redirect('topic_show', tid => $topicId, msg => 'PollDel'); 78 | -------------------------------------------------------------------------------- /script/log_delete.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | #------------------------------------------------------------------------------ 3 | # mwForum - Web-based discussion forum 4 | # Copyright (c) 1999-2015 Markus Wichitill 5 | # 6 | # This program is free software; you can redistribute it and/or modify 7 | # it under the terms of the GNU General Public License as published by 8 | # the Free Software Foundation; either version 3 of the License, or 9 | # (at your option) any later version. 10 | # 11 | # This program is distributed in the hope that it will be useful, 12 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | # GNU General Public License for more details. 15 | #------------------------------------------------------------------------------ 16 | 17 | use strict; 18 | use warnings; 19 | no warnings qw(uninitialized redefine); 20 | 21 | # Imports 22 | use MwfMain; 23 | 24 | #------------------------------------------------------------------------------ 25 | 26 | # Init 27 | my ($m, $cfg, $lng, $user, $userId) = MwfMain->new($_[0]); 28 | 29 | # Check if user is admin 30 | $user->{admin} or $m->error('errNoAccess'); 31 | 32 | # Get CGI parameters 33 | my $maxAge = $m->paramInt('maxAge'); 34 | my $submitted = $m->paramBool('subm'); 35 | 36 | # Process form 37 | if ($submitted) { 38 | # Check request source authentication 39 | $m->checkSourceAuth() or $m->formError('errSrcAuth'); 40 | 41 | # If there's no error, finish action 42 | if (!@{$m->{formErrors}}) { 43 | # Delete log lines older than maxAge days 44 | if (!$maxAge) { 45 | $m->dbDo(" 46 | DELETE FROM log"); 47 | } 48 | else { 49 | $m->dbDo(" 50 | DELETE FROM log WHERE logTime < ? - ? * 86400", $m->{now}, $maxAge); 51 | } 52 | 53 | # Log action and finish 54 | $m->logAction(1, 'log', 'delete', $userId); 55 | $m->redirect('log_admin'); 56 | } 57 | } 58 | 59 | # Print form 60 | if (!$submitted || @{$m->{formErrors}}) { 61 | # Print header 62 | $m->printHeader(); 63 | 64 | # Print page bar 65 | my @navLinks = ({ url => $m->url('log_admin'), txt => 'comUp', ico => 'up' }); 66 | $m->printPageBar(mainTitle => "Log", navLinks => \@navLinks); 67 | 68 | # Print hints and form errors 69 | $m->printFormErrors(); 70 | 71 | # Print notification message form 72 | print 73 | "
\n", 74 | "
\n", 75 | "
Delete Log Entries
\n", 76 | "
\n", 77 | "
\n", 78 | "\n", 80 | "
\n", 81 | $m->submitButton("Delete", 'delete'), 82 | $m->stdFormFields(), 83 | "
\n", 84 | "
\n", 85 | "
\n\n"; 86 | 87 | # Log action and finish 88 | $m->logAction(3, 'log', 'delete', $userId); 89 | $m->printFooter(); 90 | } 91 | $m->finish(); 92 | -------------------------------------------------------------------------------- /util/util_fixtablecase.sql: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------- 2 | -- mwForum - Web-based discussion forum 3 | -- Copyright (c) 1999-2015 Markus Wichitill 4 | -- 5 | -- This program is free software; you can redistribute it and/or modify 6 | -- it under the terms of the GNU General Public License as published by 7 | -- the Free Software Foundation; either version 3 of the License, or 8 | -- (at your option) any later version. 9 | -- 10 | -- This program is distributed in the hope that it will be useful, 11 | -- but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | -- GNU General Public License for more details. 14 | ------------------------------------------------------------------------------- 15 | 16 | -- Rename tables to original case if lost under MySQL (Windows, InnoDB) 17 | ALTER TABLE boardadmingroups RENAME TO tmp_boardAdminGroups; 18 | ALTER TABLE boardhiddenflags RENAME TO tmp_boardHiddenFlags; 19 | ALTER TABLE boardmembergroups RENAME TO tmp_boardMemberGroups; 20 | ALTER TABLE boardsubscriptions RENAME TO tmp_boardSubscriptions; 21 | ALTER TABLE groupadmins RENAME TO tmp_groupAdmins; 22 | ALTER TABLE groupmembers RENAME TO tmp_groupMembers; 23 | ALTER TABLE polloptions RENAME TO tmp_pollOptions; 24 | ALTER TABLE pollvotes RENAME TO tmp_pollVotes; 25 | ALTER TABLE postlikes RENAME TO tmp_postLikes; 26 | ALTER TABLE postreports RENAME TO tmp_postReports; 27 | ALTER TABLE topicreadtimes RENAME TO tmp_topicReadTimes; 28 | ALTER TABLE topicsubscriptions RENAME TO tmp_topicSubscriptions; 29 | ALTER TABLE userbadges RENAME TO tmp_userBadges; 30 | ALTER TABLE userbans RENAME TO tmp_userBans; 31 | ALTER TABLE userignores RENAME TO tmp_userIgnores; 32 | ALTER TABLE uservariables RENAME TO tmp_userVariables; 33 | ALTER TABLE watchusers RENAME TO tmp_watchUsers; 34 | ALTER TABLE watchwords RENAME TO tmp_watchWords; 35 | 36 | ALTER TABLE tmp_boardAdminGroups RENAME TO boardAdminGroups; 37 | ALTER TABLE tmp_boardHiddenFlags RENAME TO boardHiddenFlags; 38 | ALTER TABLE tmp_boardMemberGroups RENAME TO boardMemberGroups; 39 | ALTER TABLE tmp_boardSubscriptions RENAME TO boardSubscriptions; 40 | ALTER TABLE tmp_groupAdmins RENAME TO groupAdmins; 41 | ALTER TABLE tmp_groupMembers RENAME TO groupMembers; 42 | ALTER TABLE tmp_pollOptions RENAME TO pollOptions; 43 | ALTER TABLE tmp_pollVotes RENAME TO pollVotes; 44 | ALTER TABLE tmp_postLikes RENAME TO postLikes; 45 | ALTER TABLE tmp_postReports RENAME TO postReports; 46 | ALTER TABLE tmp_topicReadTimes RENAME TO topicReadTimes; 47 | ALTER TABLE tmp_topicSubscriptions RENAME TO topicSubscriptions; 48 | ALTER TABLE tmp_userBadges RENAME TO userBadges; 49 | ALTER TABLE tmp_userBans RENAME TO userBans; 50 | ALTER TABLE tmp_userIgnores RENAME TO userIgnores; 51 | ALTER TABLE tmp_userVariables RENAME TO userVariables; 52 | ALTER TABLE tmp_watchUsers RENAME TO watchUsers; 53 | ALTER TABLE tmp_watchWords RENAME TO watchWords; 54 | -------------------------------------------------------------------------------- /script/user_ticket.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | #------------------------------------------------------------------------------ 3 | # mwForum - Web-based discussion forum 4 | # Copyright (c) 1999-2015 Markus Wichitill 5 | # 6 | # This program is free software; you can redistribute it and/or modify 7 | # it under the terms of the GNU General Public License as published by 8 | # the Free Software Foundation; either version 3 of the License, or 9 | # (at your option) any later version. 10 | # 11 | # This program is distributed in the hope that it will be useful, 12 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | # GNU General Public License for more details. 15 | #------------------------------------------------------------------------------ 16 | 17 | use strict; 18 | use warnings; 19 | no warnings qw(uninitialized redefine); 20 | 21 | # Imports 22 | use MwfMain; 23 | 24 | #------------------------------------------------------------------------------ 25 | 26 | # Init 27 | my ($m, $cfg, $lng, $user, $userId) = MwfMain->new($_[0]); 28 | 29 | # Get CGI parameters 30 | my $ticketId = $m->paramStr('t'); 31 | 32 | # Get ticket 33 | my $caseSensitive = $m->{mysql} ? 'BINARY' : 'TEXT'; 34 | my $ticket = $m->fetchHash(" 35 | SELECT * FROM tickets WHERE id = CAST(? AS $caseSensitive) AND issueTime > ? - 2 * 86400", 36 | $ticketId, $m->{now}); 37 | $ticket or $m->error('errTktNotFnd'); 38 | 39 | # Get user 40 | my $dbUser = $m->getUser($ticket->{userId}); 41 | $dbUser or $m->error('errUsrNotFnd'); 42 | 43 | # Login ticket (freshly registered) 44 | if ($ticket->{type} eq 'usrReg') { 45 | # Set cookie 46 | $m->setCookie('login', "$dbUser->{id}:$dbUser->{loginAuth}", $dbUser->{tempLogin}); 47 | 48 | # Delete user's login tickets 49 | $m->dbDo(" 50 | DELETE FROM tickets WHERE userId = ? AND type = ?", $dbUser->{id}, 'usrReg'); 51 | 52 | # Log action and finish 53 | $m->logAction(1, 'user', 'tkusrreg', $dbUser->{id}); 54 | $m->redirect('forum'); 55 | } 56 | # Login ticket (forgot password) 57 | elsif ($ticket->{type} eq 'fgtPwd') { 58 | # Set cookies 59 | $m->setCookie('login', "$dbUser->{id}:$dbUser->{loginAuth}", $dbUser->{tempLogin}); 60 | 61 | # Delete user's login tickets 62 | $m->dbDo(" 63 | DELETE FROM tickets WHERE userId = ? AND type = ?", $dbUser->{id}, 'fgtPwd'); 64 | 65 | # Log action and finish 66 | $m->logAction(1, 'user', 'tkfgtpwd', $dbUser->{id}); 67 | $m->redirect('user_password', msg => 'TkaFgtPwd'); 68 | } 69 | # Email change ticket 70 | elsif ($ticket->{type} eq 'emlChg') { 71 | # Change email address 72 | $m->dbDo(" 73 | UPDATE users SET email = ? WHERE id = ?", $ticket->{data}, $dbUser->{id}); 74 | 75 | # Delete all email change tickets 76 | $m->dbDo(" 77 | DELETE FROM tickets WHERE userId = ? AND type = ?", $dbUser->{id}, 'emlChg'); 78 | 79 | # Log action and finish 80 | $m->logAction(1, 'user', 'tkemlchg', $dbUser->{id}); 81 | $m->redirect('forum_show', msg => 'TkaEmlChg'); 82 | } 83 | -------------------------------------------------------------------------------- /script/forum_policy.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | #------------------------------------------------------------------------------ 3 | # mwForum - Web-based discussion forum 4 | # Copyright (c) 1999-2015 Markus Wichitill 5 | # 6 | # This program is free software; you can redistribute it and/or modify 7 | # it under the terms of the GNU General Public License as published by 8 | # the Free Software Foundation; either version 3 of the License, or 9 | # (at your option) any later version. 10 | # 11 | # This program is distributed in the hope that it will be useful, 12 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | # GNU General Public License for more details. 15 | #------------------------------------------------------------------------------ 16 | 17 | use strict; 18 | use warnings; 19 | no warnings qw(uninitialized redefine); 20 | 21 | # Imports 22 | use MwfMain; 23 | 24 | #------------------------------------------------------------------------------ 25 | 26 | # Init 27 | my ($m, $cfg, $lng, $user, $userId) = MwfMain->new($_[0], allowBanned => 1); 28 | 29 | # Check if access should be denied 30 | $userId or $m->error('errNoAccess'); 31 | 32 | # Get CGI parameters 33 | my $accept = $m->paramBool('accept'); 34 | my $reject = $m->paramBool('reject'); 35 | my $read = $m->paramBool('read'); 36 | my $submitted = $m->paramBool('subm'); 37 | 38 | # Process form 39 | if ($submitted) { 40 | if ($accept) { 41 | # Check request source authentication 42 | $m->checkSourceAuth() or $m->formError('errSrcAuth'); 43 | 44 | # Check that policy was read 45 | $read or $m->formError('errPlcRead'); 46 | 47 | # If there's no error, finish action 48 | if (!@{$m->{formErrors}}) { 49 | # Update user 50 | $m->dbDo(" 51 | UPDATE users SET policyAccept = ? WHERE id = ?", $cfg->{policyVersion}, $userId); 52 | 53 | # Log action and finish 54 | $m->logAction(1, 'forum', 'policy', $userId); 55 | $m->redirect('forum_show'); 56 | } 57 | } 58 | elsif ($reject) { 59 | $m->redirect('user_logout', auth => 1); 60 | } 61 | } 62 | 63 | # Print form 64 | if (!$submitted || @{$m->{formErrors}}) { 65 | # Print header 66 | $m->printHeader(); 67 | 68 | # Print page bar 69 | $m->printPageBar(mainTitle => $cfg->{policyTitle}); 70 | 71 | # Print hints and form errors 72 | $m->printFormErrors(); 73 | 74 | # Print policy 75 | my $policyEsc = $m->escHtml($cfg->{policy}, 2); 76 | print 77 | "
\n", 78 | "
\n", 79 | "
\n", 80 | "
$policyEsc
\n", 81 | $m->submitButton('plcRejectB', undef, 'reject'), 82 | $m->submitButton('plcAcceptB', undef, 'accept'), 83 | "\n", 84 | $m->stdFormFields(), 85 | "
\n", 86 | "
\n", 87 | "
\n\n"; 88 | 89 | # Log action and finish 90 | $m->logAction(3, 'forum', 'policy', $userId); 91 | $m->printFooter(); 92 | } 93 | $m->finish(); 94 | -------------------------------------------------------------------------------- /script/group_admin.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | #------------------------------------------------------------------------------ 3 | # mwForum - Web-based discussion forum 4 | # Copyright (c) 1999-2015 Markus Wichitill 5 | # 6 | # This program is free software; you can redistribute it and/or modify 7 | # it under the terms of the GNU General Public License as published by 8 | # the Free Software Foundation; either version 3 of the License, or 9 | # (at your option) any later version. 10 | # 11 | # This program is distributed in the hope that it will be useful, 12 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | # GNU General Public License for more details. 15 | #------------------------------------------------------------------------------ 16 | 17 | use strict; 18 | use warnings; 19 | no warnings qw(uninitialized redefine); 20 | 21 | # Imports 22 | use MwfMain; 23 | 24 | #------------------------------------------------------------------------------ 25 | 26 | # Init 27 | my ($m, $cfg, $lng, $user, $userId) = MwfMain->new($_[0]); 28 | 29 | # Check if user is admin 30 | $user->{admin} or $m->error('errNoAccess'); 31 | 32 | # Print header 33 | $m->printHeader(); 34 | 35 | # Print page bar 36 | my @navLinks = ({ url => $m->url('forum_show'), txt => 'comUp', ico => 'up' }); 37 | $m->printPageBar(mainTitle => "Group Administration", navLinks => \@navLinks); 38 | 39 | # Print create board form 40 | print 41 | "
\n", 42 | "
\n", 43 | "
Create Group
\n", 44 | "
\n", 45 | $m->submitButton("Create", 'group'), 46 | $m->stdFormFields(), 47 | "
\n", 48 | "
\n", 49 | "
\n\n"; 50 | 51 | # Get groups 52 | my $groups = $m->fetchAllHash(" 53 | SELECT id, title FROM groups ORDER BY title"); 54 | 55 | # Print group list 56 | print 57 | "\n", 58 | "\n", 59 | "\n", 60 | "\n", 61 | "\n"; 62 | 63 | for my $group (@$groups) { 64 | my $groupId = $group->{id}; 65 | my $infUrl = $m->url('group_info', gid => $groupId); 66 | my $optUrl = $m->url('group_options', gid => $groupId, ori => 1); 67 | my $mbrUrl = $m->url('group_members', gid => $groupId); 68 | my $brdUrl = $m->url('group_boards', gid => $groupId, ori => 1); 69 | my $delUrl = $m->url('user_confirm', gid => $groupId, script => 'group_delete', 70 | name => $group->{title}, ori => 1); 71 | print 72 | "\n", 73 | "\n", 74 | "\n"; 80 | } 81 | 82 | print "
TitleCommands
$group->{title}\n", 75 | "Opt\n", 76 | "Mbr\n", 77 | "Brd\n", 78 | "Del\n", 79 | "
\n\n"; 83 | 84 | # Log action and finish 85 | $m->logAction(3, 'group', 'admin', $userId); 86 | $m->printFooter(); 87 | $m->finish(); 88 | -------------------------------------------------------------------------------- /script/topic_delete.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | #------------------------------------------------------------------------------ 3 | # mwForum - Web-based discussion forum 4 | # Copyright (c) 1999-2015 Markus Wichitill 5 | # 6 | # This program is free software; you can redistribute it and/or modify 7 | # it under the terms of the GNU General Public License as published by 8 | # the Free Software Foundation; either version 3 of the License, or 9 | # (at your option) any later version. 10 | # 11 | # This program is distributed in the hope that it will be useful, 12 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | # GNU General Public License for more details. 15 | #------------------------------------------------------------------------------ 16 | 17 | use strict; 18 | use warnings; 19 | no warnings qw(uninitialized redefine); 20 | 21 | # Imports 22 | use MwfMain; 23 | 24 | #------------------------------------------------------------------------------ 25 | 26 | # Init 27 | my ($m, $cfg, $lng, $user, $userId) = MwfMain->new($_[0]); 28 | 29 | # Get CGI parameters 30 | my $topicId = $m->paramInt('tid'); 31 | my $notify = $m->paramBool('notify'); 32 | my $reason = $m->paramStr('reason'); 33 | $topicId or $m->error('errParamMiss'); 34 | 35 | # Check request source authentication 36 | $m->checkSourceAuth() or $m->error('errSrcAuth'); 37 | 38 | # Get topic 39 | my $topic = $m->fetchHash(" 40 | SELECT topics.boardId, topics.pollId, topics.lastPostTime, topics.subject, 41 | posts.userId 42 | FROM topics AS topics 43 | INNER JOIN posts AS posts 44 | ON posts.id = topics.basePostId 45 | WHERE topics.id = ?", $topicId); 46 | $topic or $m->error('errTpcNotFnd'); 47 | my $boardId = $topic->{boardId}; 48 | 49 | # Get board 50 | my $board = $m->fetchHash(" 51 | SELECT topicAdmins FROM boards WHERE id = ?", $boardId); 52 | 53 | # Check if user is admin or moderator 54 | $user->{admin} || $m->boardAdmin($userId, $boardId) 55 | || $board->{topicAdmins} && $m->topicAdmin($userId, $topicId) 56 | or $m->error('errNoAccess'); 57 | 58 | # Get previous topic id for redirection to same page 59 | my $prevTopicId = $m->fetchArray(" 60 | SELECT id 61 | FROM topics 62 | WHERE boardId = :boardId 63 | AND lastPostTime > :lastPostTime 64 | ORDER BY lastPostTime 65 | LIMIT 1", 66 | { boardId => $boardId, lastPostTime => $topic->{lastPostTime} }); 67 | 68 | # Delete topic 69 | my $trash = $cfg->{trashBoardId} && $cfg->{trashBoardId} != $boardId; 70 | $m->deleteTopic($topicId, $trash); 71 | $m->recalcStats([ $boardId, $trash ? $cfg->{trashBoardId} : () ]); 72 | 73 | # Add notification message 74 | $m->addNote('tpcDel', $topic->{userId}, 'notTpcDel', tpcSbj => $topic->{subject}, reason => $reason) 75 | if $notify && $topic->{userId} && $topic->{userId} != $userId; 76 | 77 | # Log action and finish 78 | $m->logAction(1, 'topic', 'delete', $userId, $boardId, $topicId); 79 | $m->redirect('board_show', $prevTopicId ? (tid => $prevTopicId, tgt => "tid$prevTopicId") 80 | : (bid => $boardId), msg => 'TpcDelete'); 81 | -------------------------------------------------------------------------------- /util/util_fixcharset.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | #------------------------------------------------------------------------------ 3 | # mwForum - Web-based discussion forum 4 | # Copyright (c) 1999-2015 Markus Wichitill 5 | # 6 | # This program is free software; you can redistribute it and/or modify 7 | # it under the terms of the GNU General Public License as published by 8 | # the Free Software Foundation; either version 3 of the License, or 9 | # (at your option) any later version. 10 | # 11 | # This program is distributed in the hope that it will be useful, 12 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | # GNU General Public License for more details. 15 | #------------------------------------------------------------------------------ 16 | 17 | # Change the charset declaration of text columns in MySQL DBs so that 18 | # conversion to UTF-8 doesn't result in garbage during 2.15.0 upgrade, 19 | # if the charset declared so far is not correct. 20 | # See http://dev.mysql.com/doc/refman/4.1/en/charset-charsets.html for names of 21 | # charsets in MySQL format. 22 | 23 | use strict; 24 | use warnings; 25 | no warnings qw(uninitialized); 26 | 27 | # Imports 28 | use Getopt::Std (); 29 | require MwfMain; 30 | 31 | #------------------------------------------------------------------------------ 32 | 33 | # Get arguments 34 | my %opts = (); 35 | Getopt::Std::getopts('?hf:c:', \%opts); 36 | my $help = $opts{'?'} || $opts{h}; 37 | my $forumId = $opts{f}; 38 | my $charset = $opts{c}; 39 | usage() if $help; 40 | $charset or usage(); 41 | 42 | # Init 43 | my ($m, $cfg, $lng) = MwfMain->newShell(forumId => $forumId); 44 | 45 | open my $fh, "install.pl" or $m->error("Opening install.pl failed"); 46 | while (my $line = <$fh>) { 47 | if (my ($table) = $line =~ /^CREATE TABLE (\w+)/) { 48 | while ($line = <$fh>) { 49 | last if $line =~ /^\)/; 50 | my ($col, $type) = $line =~ /^\t(\w+)\s+((?:TEXT|VARCHAR\([0-9]+\)) NOT NULL DEFAULT '')/; 51 | if ($type =~ /^(?:TEXT|VARCHAR)/) { 52 | my $blob = $type; 53 | $blob =~ s!VARCHAR!VARBINARY!; 54 | $blob =~ s!TEXT!BLOB!; 55 | $type =~ s!(VARCHAR\([0-9]+\)|TEXT)!$1 CHARSET $charset!; 56 | print "ALTER TABLE $table CHANGE $col $col $blob;\n"; 57 | print "ALTER TABLE $table CHANGE $col $col $type;\n"; 58 | $m->dbDo("ALTER TABLE $cfg->{dbPrefix}$table CHANGE $col $col $blob"); 59 | $m->dbDo("ALTER TABLE $cfg->{dbPrefix}$table CHANGE $col $col $type"); 60 | } 61 | } 62 | print "ALTER TABLE $table CHARSET $charset;\n"; 63 | $m->dbDo("ALTER TABLE $cfg->{dbPrefix}$table CHARSET $charset"); 64 | } 65 | } 66 | 67 | #------------------------------------------------------------------------------ 68 | 69 | sub usage 70 | { 71 | print 72 | "\nFix character set declarations in MySQL databases.\n\n", 73 | "Usage: util_fixcharset.pl [-f forum] -c charset\n", 74 | " -f Forum hostname or URL path when using a multi-forum installation.\n", 75 | " -c Name of the correct charset in MySQL format (e.g. koi8r).\n", 76 | ; 77 | 78 | exit 1; 79 | } 80 | -------------------------------------------------------------------------------- /script/poll_lock.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | #------------------------------------------------------------------------------ 3 | # mwForum - Web-based discussion forum 4 | # Copyright (c) 1999-2015 Markus Wichitill 5 | # 6 | # This program is free software; you can redistribute it and/or modify 7 | # it under the terms of the GNU General Public License as published by 8 | # the Free Software Foundation; either version 3 of the License, or 9 | # (at your option) any later version. 10 | # 11 | # This program is distributed in the hope that it will be useful, 12 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | # GNU General Public License for more details. 15 | #------------------------------------------------------------------------------ 16 | 17 | use strict; 18 | use warnings; 19 | no warnings qw(uninitialized redefine); 20 | 21 | # Imports 22 | use MwfMain; 23 | 24 | #------------------------------------------------------------------------------ 25 | 26 | # Init 27 | my ($m, $cfg, $lng, $user, $userId) = MwfMain->new($_[0]); 28 | 29 | # Get CGI parameters 30 | my $topicId = $m->paramInt('tid'); 31 | 32 | # Check request source authentication 33 | $m->checkSourceAuth() or $m->error('errSrcAuth'); 34 | 35 | # Get topic 36 | my ($boardId, $pollId, $topicUserId) = $m->fetchArray(" 37 | SELECT topics.boardId, topics.pollId, posts.userId 38 | FROM topics AS topics 39 | INNER JOIN posts AS posts 40 | ON posts.id = topics.basePostId 41 | WHERE topics.id = ?", $topicId); 42 | $boardId or $m->error('errTpcNotFnd'); 43 | 44 | # Get board 45 | my $board = $m->fetchHash(" 46 | SELECT * FROM boards WHERE id = ?", $boardId); 47 | $board or $m->error('errBrdNotFnd'); 48 | 49 | # Check if user can see and write to board 50 | my $boardAdmin = $user->{admin} || $m->boardAdmin($userId, $boardId) 51 | || $board->{topicAdmins} && $m->topicAdmin($userId, $topicId); 52 | $boardAdmin || $m->boardVisible($board) or $m->error('errNoAccess'); 53 | $boardAdmin || $m->boardWritable($board, 1) or $m->error('errNoAccess'); 54 | 55 | # Check if user owns topic or is moderator 56 | $userId == $topicUserId || $boardAdmin or $m->error('errNoAccess'); 57 | 58 | # Check if poll is already locked 59 | my $poll = $m->fetchHash(" 60 | SELECT locked FROM polls WHERE id = ?", $pollId); 61 | $poll or $m->error('errPolNotFnd'); 62 | !$poll->{locked} or $m->error('errPolLocked'); 63 | 64 | # Mark poll as locked 65 | $m->dbDo(" 66 | UPDATE polls SET locked = 1 WHERE id = ?", $pollId); 67 | 68 | # Consolidate votes 69 | my $voteSums = $m->fetchAllArray(" 70 | SELECT optionId, COUNT(*) FROM pollVotes WHERE pollId = ? GROUP BY optionId", $pollId); 71 | 72 | # Set option sums 73 | for my $voteSum (@$voteSums) { 74 | $m->dbDo(" 75 | UPDATE pollOptions SET votes = ? WHERE id = ?", $voteSum->[1], $voteSum->[0]); 76 | } 77 | 78 | # Delete individual votes 79 | $m->dbDo(" 80 | DELETE FROM pollVotes WHERE pollId = ?", $pollId); 81 | 82 | # Log action and finish 83 | $m->logAction(1, 'poll', 'lock', $userId, $boardId, $topicId, undef, $pollId); 84 | $m->redirect('topic_show', tid => $topicId, msg => 'PollLock'); 85 | -------------------------------------------------------------------------------- /script/branch_lock.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | #------------------------------------------------------------------------------ 3 | # mwForum - Web-based discussion forum 4 | # Copyright (c) 1999-2015 Markus Wichitill 5 | # 6 | # This program is free software; you can redistribute it and/or modify 7 | # it under the terms of the GNU General Public License as published by 8 | # the Free Software Foundation; either version 3 of the License, or 9 | # (at your option) any later version. 10 | # 11 | # This program is distributed in the hope that it will be useful, 12 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | # GNU General Public License for more details. 15 | #------------------------------------------------------------------------------ 16 | 17 | use strict; 18 | use warnings; 19 | no warnings qw(uninitialized redefine); 20 | 21 | # Imports 22 | use MwfMain; 23 | 24 | #------------------------------------------------------------------------------ 25 | 26 | # Init 27 | my ($m, $cfg, $lng, $user, $userId) = MwfMain->new($_[0]); 28 | 29 | # Get CGI parameters 30 | my $postId = $m->paramInt('pid'); 31 | my $lock = $m->paramBool('lock'); 32 | my $unlock = $m->paramBool('unlock'); 33 | $postId or $m->error('errParamMiss'); 34 | 35 | # Check request source authentication 36 | $m->checkSourceAuth() or $m->error('errSrcAuth'); 37 | 38 | # Get branch base post 39 | my ($boardId, $topicId, $parentId) = $m->fetchArray(" 40 | SELECT boardId, topicId, parentId FROM posts WHERE id = ?", $postId); 41 | $boardId or $m->error('errPstNotFnd'); 42 | 43 | # Get board 44 | my $board = $m->fetchHash(" 45 | SELECT topicAdmins FROM boards WHERE id = ?", $boardId); 46 | 47 | # Get topic base post 48 | my $basePostId = $m->fetchArray(" 49 | SELECT basePostId FROM topics WHERE id = ?", $topicId); 50 | $basePostId != $postId or $m->error('errPromoTpc'); 51 | 52 | # Check if user is admin or moderator 53 | $user->{admin} || $m->boardAdmin($userId, $boardId) 54 | || $board->{topicAdmins} && $m->topicAdmin($userId, $topicId) 55 | or $m->error('errNoAccess'); 56 | 57 | # Get posts 58 | my $posts = $m->fetchAllHash(" 59 | SELECT id, parentId FROM posts WHERE topicId = ?", $topicId); 60 | 61 | # Put posts in by-parent lookup table 62 | my %postsByParent = (); 63 | push @{$postsByParent{$_->{parentId}}}, $_ for @$posts; 64 | 65 | # Get branch post ids 66 | my @branchPostIds = (); 67 | my $getBranchPostIds = sub { 68 | my $self = shift(); 69 | my $pid = shift(); 70 | 71 | push @branchPostIds, $pid; 72 | 73 | # Recurse through children 74 | for my $child (@{$postsByParent{$pid}}) { 75 | $child->{id} != $pid or $m->error("Post is its own parent?!"); 76 | $self->($self, $child->{id}); 77 | } 78 | }; 79 | $getBranchPostIds->($getBranchPostIds, $postId); 80 | 81 | # Lock or unlock 82 | $m->dbDo(" 83 | UPDATE posts SET locked = :locked WHERE id IN (:branchPostIds)", 84 | { locked => $lock ? 1 : 0, branchPostIds => \@branchPostIds }); 85 | 86 | # Log action and finish 87 | $m->logAction(1, 'branch', $lock ? 'lock' : 'unlock', $userId, $boardId, $topicId, $postId); 88 | $m->redirect('topic_show', pid => $postId, msg => 'BrnLock'); 89 | -------------------------------------------------------------------------------- /script/user_notify.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | #------------------------------------------------------------------------------ 3 | # mwForum - Web-based discussion forum 4 | # Copyright (c) 1999-2015 Markus Wichitill 5 | # 6 | # This program is free software; you can redistribute it and/or modify 7 | # it under the terms of the GNU General Public License as published by 8 | # the Free Software Foundation; either version 3 of the License, or 9 | # (at your option) any later version. 10 | # 11 | # This program is distributed in the hope that it will be useful, 12 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | # GNU General Public License for more details. 15 | #------------------------------------------------------------------------------ 16 | 17 | use strict; 18 | use warnings; 19 | no warnings qw(uninitialized redefine); 20 | 21 | # Imports 22 | use MwfMain; 23 | 24 | #------------------------------------------------------------------------------ 25 | 26 | # Init 27 | my ($m, $cfg, $lng, $user, $userId) = MwfMain->new($_[0]); 28 | 29 | # Check if user is admin 30 | $user->{admin} or $m->error('errNoAccess'); 31 | 32 | # Get CGI parameters 33 | my $recvId = $m->paramInt('uid'); 34 | my $body = $m->paramStr('body'); 35 | my $submitted = $m->paramBool('subm'); 36 | 37 | # Get user 38 | my $recvUser = $m->getUser($recvId); 39 | $recvUser or $m->error('errUsrNotFnd'); 40 | 41 | # Process form 42 | if ($submitted) { 43 | # Check request source authentication 44 | $m->checkSourceAuth() or $m->formError('errSrcAuth'); 45 | 46 | # Translate text 47 | my $note = { isNote => 1, body => $body }; 48 | $m->editToDb({}, $note); 49 | 50 | # If there's no error, finish action 51 | if (!@{$m->{formErrors}}) { 52 | # Insert notification message 53 | $m->addNote('admMsg', $recvId, $note->{body}); 54 | 55 | # Log action and finish 56 | $m->logAction(1, 'note', 'add', $userId, 0, 0, 0, $recvId); 57 | $m->redirect('user_info', uid => $recvId); 58 | } 59 | } 60 | 61 | # Print form 62 | if (!$submitted || @{$m->{formErrors}}) { 63 | # Print header 64 | $m->printHeader(); 65 | 66 | # Print page bar 67 | my @navLinks = ({ url => $m->url('user_info', uid => $recvId), txt => 'comUp', ico => 'up' }); 68 | $m->printPageBar(mainTitle => "User", subTitle => $recvUser->{userName}, navLinks => \@navLinks); 69 | 70 | # Print hints and form errors 71 | $m->printFormErrors(); 72 | 73 | # Prepare values 74 | my $bodyEsc = $m->escHtml($body, 1); 75 | 76 | # Print notification message form 77 | print 78 | "
\n", 79 | "
\n", 80 | "
Send Notification Message
\n", 81 | "
\n", 82 | "\n", 84 | $m->submitButton("Send", 'write', 'add'), 85 | "\n", 86 | $m->stdFormFields(), 87 | "
\n", 88 | "
\n", 89 | "
\n\n"; 90 | 91 | # Log action and finish 92 | $m->logAction(3, 'note', 'add', $userId, 0, 0, 0, $recvId); 93 | $m->printFooter(); 94 | } 95 | $m->finish(); 96 | -------------------------------------------------------------------------------- /script/message_delete.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | #------------------------------------------------------------------------------ 3 | # mwForum - Web-based discussion forum 4 | # Copyright (c) 1999-2015 Markus Wichitill 5 | # 6 | # This program is free software; you can redistribute it and/or modify 7 | # it under the terms of the GNU General Public License as published by 8 | # the Free Software Foundation; either version 3 of the License, or 9 | # (at your option) any later version. 10 | # 11 | # This program is distributed in the hope that it will be useful, 12 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | # GNU General Public License for more details. 15 | #------------------------------------------------------------------------------ 16 | 17 | use strict; 18 | use warnings; 19 | no warnings qw(uninitialized redefine); 20 | 21 | # Imports 22 | use MwfMain; 23 | 24 | #------------------------------------------------------------------------------ 25 | 26 | # Init 27 | my ($m, $cfg, $lng, $user, $userId) = MwfMain->new($_[0]); 28 | 29 | # Check if access should be denied 30 | $cfg->{messages} or $m->error('errNoAccess'); 31 | $userId or $m->error('errNoAccess'); 32 | 33 | # Get CGI parameters 34 | my $action = $m->paramStrId('act'); 35 | my $msgId = $m->paramInt('mid'); 36 | 37 | # Check request source authentication 38 | $m->checkSourceAuth() or $m->error('errSrcAuth'); 39 | 40 | if ($action eq 'delAllRead') { 41 | # Delete all read messages 42 | $m->dbDo(" 43 | UPDATE messages SET inbox = 0 WHERE receiverId = ? AND hasRead > 0", $userId); 44 | $m->dbDo(" 45 | UPDATE messages SET sentbox = 0 WHERE senderId = ?", $userId); 46 | $m->dbDo(" 47 | DELETE FROM messages WHERE inbox = 0 AND sentbox = 0"); 48 | 49 | # Log action and finish 50 | $m->logAction(1, 'msg', 'delallrd', $userId, 0, 0, 0, $msgId); 51 | $m->redirect('message_list', msg => 'MsgDel'); 52 | } 53 | else { 54 | $msgId or $m->error('errParamMiss'); 55 | 56 | # Get message 57 | my $msg = $m->fetchHash(" 58 | SELECT senderId, receiverId, inbox, sentbox FROM messages WHERE id = ?", $msgId); 59 | $msg or $m->error('errMsgNotFnd'); 60 | my $received = $msg->{receiverId} == $userId; 61 | my $sent = $msg->{senderId} == $userId; 62 | 63 | # Check if user can see message 64 | $received && $msg->{inbox} || $sent && $msg->{sentbox} or $m->error('errNoAccess'); 65 | 66 | # Delete or remove from box 67 | if (($received && $sent) 68 | || ($received && $msg->{inbox} && !$msg->{sentbox}) 69 | || ($sent && $msg->{sentbox} && !$msg->{inbox})) { 70 | # Delete message 71 | $m->dbDo(" 72 | DELETE FROM messages WHERE id = ?", $msgId); 73 | } 74 | elsif ($received && $msg->{inbox} && $msg->{sentbox}) { 75 | # Remove from inbox 76 | $m->dbDo(" 77 | UPDATE messages SET inbox = 0 WHERE id = ?", $msgId); 78 | } 79 | elsif ($sent && $msg->{sentbox} && $msg->{inbox}) { 80 | # Remove from sentbox 81 | $m->dbDo(" 82 | UPDATE messages SET sentbox = 0 WHERE id = ?", $msgId); 83 | } 84 | else { 85 | $m->error('errMsgNotFnd'); 86 | } 87 | 88 | # Log action and finish 89 | $m->logAction(1, 'msg', 'delete', $userId, 0, 0, 0, $msgId); 90 | $m->redirect('message_list', msg => 'MsgDel'); 91 | } 92 | -------------------------------------------------------------------------------- /example/MwfPlgMsgDisplay.pm: -------------------------------------------------------------------------------- 1 | #------------------------------------------------------------------------------ 2 | # mwForum - Web-based discussion forum 3 | # Copyright © 1999-2015 Markus Wichitill 4 | # 5 | # This program is free software; you can redistribute it and/or modify 6 | # it under the terms of the GNU General Public License as published by 7 | # the Free Software Foundation; either version 3 of the License, or 8 | # (at your option) any later version. 9 | # 10 | # This program is distributed in the hope that it will be useful, 11 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | # GNU General Public License for more details. 14 | #------------------------------------------------------------------------------ 15 | 16 | package MwfPlgMsgDisplay; 17 | use utf8; 18 | use strict; 19 | use warnings; 20 | no warnings qw(uninitialized redefine); 21 | our $VERSION = "2.29.1"; 22 | 23 | #------------------------------------------------------------------------------ 24 | # Replace text with image smileys 25 | 26 | sub smileys 27 | { 28 | my %params = @_; 29 | my $m = $params{m}; 30 | my $board = $params{board}; 31 | my $post = $params{post}; 32 | 33 | # Replace smileys 34 | if ($m->{user}{showDeco}) { 35 | my $text = \$post->{body}; 36 | $$text =~ s~(?~g; 37 | $$text =~ s~(?~g; 38 | $$text =~ s~(?~g; 39 | $$text =~ s~(?~g; 40 | $$text =~ s~(?~g; 41 | $$text =~ s~(?~g; 42 | } 43 | 44 | return 0; 45 | } 46 | 47 | #------------------------------------------------------------------------------ 48 | # Embed attached audio files 49 | 50 | sub audio 51 | { 52 | my %params = @_; 53 | my $m = $params{m}; 54 | my $board = $params{board}; 55 | my $post = $params{post}; 56 | 57 | # Shortcuts 58 | my $cfg = $m->{cfg}; 59 | my $lng = $m->{lng}; 60 | my $text = \$post->{body}; 61 | my $attachments = $post->{attachments}; 62 | 63 | # Set translated strings 64 | if (!exists($lng->{audioTagUnsup})) { 65 | if ($m->{lngModule} eq 'MwfGerman') { 66 | $lng->{audioTagUnsup} = "Ihr Browser unterstützt das Audio-Element nicht."; 67 | } 68 | else { 69 | $lng->{audioTagUnsup} = "Your browser doesn't support the audio element."; 70 | } 71 | } 72 | 73 | # Embed attached wav and ogg audio 74 | if ($attachments && @$attachments) { 75 | for my $attach (@$attachments) { 76 | if ($attach->{fileName} =~ /\.(?:ogg|aac|mp3|wav)\z/i) { 77 | my $postIdMod = $attach->{postId} % 100; 78 | my $url = "$cfg->{attachUrlPath}/$postIdMod/$attach->{postId}/$attach->{fileName}"; 79 | $$text .= "\n

\n" 80 | . ""; 82 | $attach->{drop} = 1; 83 | } 84 | } 85 | @$attachments = grep(!$_->{drop}, @$attachments); 86 | } 87 | 88 | return 0; 89 | } 90 | 91 | #------------------------------------------------------------------------------ 92 | 1; 93 | -------------------------------------------------------------------------------- /script/attach_show.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | #------------------------------------------------------------------------------ 3 | # mwForum - Web-based discussion forum 4 | # Copyright (c) 1999-2015 Markus Wichitill 5 | # 6 | # This program is free software; you can redistribute it and/or modify 7 | # it under the terms of the GNU General Public License as published by 8 | # the Free Software Foundation; either version 3 of the License, or 9 | # (at your option) any later version. 10 | # 11 | # This program is distributed in the hope that it will be useful, 12 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | # GNU General Public License for more details. 15 | #------------------------------------------------------------------------------ 16 | 17 | use strict; 18 | use warnings; 19 | no warnings qw(uninitialized redefine); 20 | 21 | # Imports 22 | use MwfMain; 23 | 24 | #------------------------------------------------------------------------------ 25 | 26 | # Init 27 | my ($m, $cfg, $lng, $user, $userId) = MwfMain->new($_[0]); 28 | 29 | # Get CGI parameters 30 | my $attachId = $m->paramInt('aid'); 31 | 32 | # Get attachment 33 | my $attach = $m->fetchHash(" 34 | SELECT * FROM attachments WHERE id = ?", $attachId); 35 | $attach or $m->error('errAttNotFnd'); 36 | my $postId = $attach->{postId}; 37 | 38 | # Get board 39 | my $board = $m->fetchHash(" 40 | SELECT * FROM boards WHERE id = (SELECT boardId FROM posts WHERE id = ?)", $postId); 41 | 42 | # Get prev/next image attachment id 43 | my $prevAttachId = $m->fetchArray(" 44 | SELECT id 45 | FROM attachments 46 | WHERE postId = :postId 47 | AND webImage > 0 48 | AND id < :id 49 | ORDER BY id DESC 50 | LIMIT 1", 51 | { postId => $postId, id => $attachId }); 52 | my $nextAttachId = $m->fetchArray(" 53 | SELECT id 54 | FROM attachments 55 | WHERE postId = :postId 56 | AND webImage > 0 57 | AND id > :id 58 | ORDER BY id ASC 59 | LIMIT 1", 60 | { postId => $postId, id => $attachId }); 61 | 62 | # Check if user can see board 63 | $m->boardVisible($board) or $m->error('errNoAccess'); 64 | 65 | # Print header 66 | $m->printHeader(); 67 | 68 | # Print page bar 69 | my @navLinks = (); 70 | push @navLinks, { url => $m->url('attach_show', aid => $prevAttachId), 71 | txt => 'atsPrev', ico => 'prev', dsb => $prevAttachId ? 0 : 1 }; 72 | push @navLinks, { url => $m->url('attach_show', aid => $nextAttachId), 73 | txt => 'atsNext', ico => 'next', dsb => $nextAttachId ? 0 : 1 }; 74 | push @navLinks, { url => $m->url('topic_show', pid => $postId), 75 | txt => 'comUp', ico => 'up' }; 76 | $m->printPageBar(mainTitle => $lng->{atsTitle}, subTitle => $attach->{fileName}, 77 | navLinks => \@navLinks); 78 | 79 | # Print image 80 | my $postIdMod = $postId % 100; 81 | my $url = "$cfg->{attachUrlPath}/$postIdMod/$postId/$attach->{fileName}"; 82 | print "

\n\n"; 83 | 84 | # Print caption 85 | print 86 | "
\n", 87 | "
\n", 88 | "

$attach->{caption}

\n", 89 | "
\n", 90 | "
\n\n" 91 | if $attach->{caption}; 92 | 93 | # Log action and finish 94 | $m->logAction(2, 'attach', 'show', $userId, $board->{id}, 0, $postId, $attachId); 95 | $m->printFooter(1); 96 | $m->finish(); 97 | -------------------------------------------------------------------------------- /script/cron_admin.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | #------------------------------------------------------------------------------ 3 | # mwForum - Web-based discussion forum 4 | # Copyright (c) 1999-2015 Markus Wichitill 5 | # 6 | # This program is free software; you can redistribute it and/or modify 7 | # it under the terms of the GNU General Public License as published by 8 | # the Free Software Foundation; either version 3 of the License, or 9 | # (at your option) any later version. 10 | # 11 | # This program is distributed in the hope that it will be useful, 12 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | # GNU General Public License for more details. 15 | #------------------------------------------------------------------------------ 16 | 17 | use strict; 18 | use warnings; 19 | no warnings qw(uninitialized redefine); 20 | 21 | # Imports 22 | use MwfMain; 23 | 24 | #------------------------------------------------------------------------------ 25 | 26 | # Init 27 | my ($m, $cfg, $lng, $user, $userId) = MwfMain->new($_[0]); 28 | 29 | # Check if user is admin 30 | $user->{admin} or $m->error('errNoAccess'); 31 | 32 | # Get CGI parameters 33 | my $main = $m->paramBool('main'); 34 | my $subs = $m->paramBool('subs'); 35 | my $bounce = $m->paramBool('bounce'); 36 | my $rss = $m->paramBool('rss'); 37 | my $submitted = $m->paramBool('subm'); 38 | 39 | # Process form 40 | if ($submitted) { 41 | # Check request source authentication 42 | $m->checkSourceAuth() or $m->formError('errSrcAuth'); 43 | 44 | # If there's no error, finish action 45 | if (!@{$m->{formErrors}}) { 46 | # Spawn script 47 | if ($main) { $m->spawnScript('cron_jobs') } 48 | elsif ($subs) { $m->spawnScript('cron_subscriptions') } 49 | elsif ($bounce) { $m->spawnScript('cron_bounce') } 50 | elsif ($rss) { $m->spawnScript('cron_rss') } 51 | 52 | # Redirect to cronjob admin page 53 | $m->redirect('cron_admin'); 54 | } 55 | } 56 | 57 | # Print form 58 | if (!$submitted || @{$m->{formErrors}}) { 59 | # Print header 60 | $m->printHeader(); 61 | 62 | # Print page bar 63 | my @navLinks = ({ url => $m->url('forum_show'), txt => 'comUp', ico => 'up' }); 64 | $m->printPageBar(mainTitle => "Cronjob Administration", navLinks => \@navLinks); 65 | 66 | # Print hints and form errors 67 | $m->printHints(["This method of manually starting cronjobs requires the" 68 | . " \$cfg->{scriptFsPath} and \$cfg->{perlBinary}" 69 | . " options to be set up."]); 70 | $m->printFormErrors(); 71 | 72 | # Print execution form 73 | print 74 | "
\n", 75 | "
Execute Cronjobs
\n", 76 | "
\n", 77 | "
\n", 78 | "
\n", 79 | $m->submitButton("Main Cronjob (cron_jobs)", 'cron', 'main'), "
\n", 80 | $m->submitButton("Digest Subscriptions (cron_subscriptions)", 'subscribe', 'subs'), "
\n", 81 | $m->submitButton("Bounce Handler (cron_bounce)", 'subscribe', 'bounce'), "
\n", 82 | $m->submitButton("Feed Writer (cron_rss)", 'feed', 'rss'), 83 | $m->stdFormFields(), 84 | "
\n", 85 | "
\n", 86 | "
\n", 87 | "
\n\n"; 88 | 89 | # Log action and finish 90 | $m->logAction(3, 'cron', 'admin', $userId); 91 | $m->printFooter(); 92 | } 93 | $m->finish(); 94 | -------------------------------------------------------------------------------- /script/topic_info.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | #------------------------------------------------------------------------------ 3 | # mwForum - Web-based discussion forum 4 | # Copyright (c) 1999-2015 Markus Wichitill 5 | # 6 | # This program is free software; you can redistribute it and/or modify 7 | # it under the terms of the GNU General Public License as published by 8 | # the Free Software Foundation; either version 3 of the License, or 9 | # (at your option) any later version. 10 | # 11 | # This program is distributed in the hope that it will be useful, 12 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | # GNU General Public License for more details. 15 | #------------------------------------------------------------------------------ 16 | 17 | use strict; 18 | use warnings; 19 | no warnings qw(uninitialized redefine); 20 | 21 | # Imports 22 | use MwfMain; 23 | 24 | #------------------------------------------------------------------------------ 25 | 26 | # Init 27 | my ($m, $cfg, $lng, $user, $userId) = MwfMain->new($_[0]); 28 | 29 | # Print header 30 | $m->printHeader(); 31 | 32 | # Get CGI parameters 33 | my $topicId = $m->paramInt('tid'); 34 | $topicId or $m->error('errParamMiss'); 35 | 36 | # Get topic 37 | my $topic = $m->fetchHash(" 38 | SELECT * FROM topics WHERE id = ?", $topicId); 39 | $topic or $m->error('errTpcNotFnd'); 40 | my $boardId = $topic->{boardId}; 41 | 42 | # Get board 43 | my $board = $m->fetchHash(" 44 | SELECT * FROM boards WHERE id = ?", $topic->{boardId}); 45 | $board or $m->error('errBrdNotFnd'); 46 | 47 | # Is board visible to user? 48 | my $boardAdmin = $user->{admin} || $m->boardAdmin($userId, $boardId); 49 | $boardAdmin || $m->boardVisible($board) or $m->error('errNoAccess'); 50 | 51 | # Print page bar 52 | my @navLinks = ({ url => $m->url('topic_show', tid => $topicId), txt => 'comUp', ico => 'up' }); 53 | $m->printPageBar(mainTitle => "Topic Info", subTitle => $topic->{subject}, 54 | navLinks => \@navLinks); 55 | 56 | # Print topic tag 57 | if ($topic->{tag}) { 58 | my ($title) = $cfg->{topicTags}{$topic->{tag}} =~ /[\w.]+\s*(.*)?/; 59 | print 60 | "
\n", 61 | "
Tag
\n", 62 | "
\n", 63 | $m->formatTopicTag($topic->{tag}), " $title\n", 64 | "
\n", 65 | "
\n\n"; 66 | } 67 | 68 | if ($user->{admin}) { 69 | # Get subscribers 70 | my $maxUserListNum = $cfg->{maxUserListNum} || 500; 71 | my $subscribers = $m->fetchAllArray(" 72 | SELECT users.id, users.userName, topicSubscriptions.instant 73 | FROM topicSubscriptions AS topicSubscriptions 74 | INNER JOIN users AS users 75 | ON users.id = topicSubscriptions.userId 76 | WHERE topicSubscriptions.topicId = :topicId 77 | ORDER BY users.userName 78 | LIMIT :maxUserListNum", 79 | { topicId => $topicId, maxUserListNum => $maxUserListNum }); 80 | 81 | # Print subscribers 82 | print 83 | "
\n", 84 | "
Subscribers
\n", 85 | "
\n", 86 | join(",\n", map(" $_->[0]) 87 | . "' title='Instant: $_->[2]'>$_->[1]", @$subscribers)) || " - ", "\n", 88 | "
\n", 89 | "
\n\n"; 90 | } 91 | 92 | # Log action and finish 93 | $m->logAction(3, 'topic', 'info', $userId, $boardId, $topicId); 94 | $m->printFooter(); 95 | $m->finish(); 96 | -------------------------------------------------------------------------------- /script/user_mark.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | #------------------------------------------------------------------------------ 3 | # mwForum - Web-based discussion forum 4 | # Copyright (c) 1999-2015 Markus Wichitill 5 | # 6 | # This program is free software; you can redistribute it and/or modify 7 | # it under the terms of the GNU General Public License as published by 8 | # the Free Software Foundation; either version 3 of the License, or 9 | # (at your option) any later version. 10 | # 11 | # This program is distributed in the hope that it will be useful, 12 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | # GNU General Public License for more details. 15 | #------------------------------------------------------------------------------ 16 | 17 | use strict; 18 | use warnings; 19 | no warnings qw(uninitialized redefine); 20 | 21 | # Imports 22 | use MwfMain; 23 | 24 | #------------------------------------------------------------------------------ 25 | 26 | # Init 27 | my ($m, $cfg, $lng, $user, $userId) = MwfMain->new($_[0]); 28 | 29 | # Get CGI parameters 30 | my $action = $m->paramStrId('act'); 31 | my $boardId = $m->paramInt('bid') || 0; 32 | my $time = $m->paramInt('time'); 33 | 34 | if ($userId) { 35 | # Check request source authentication 36 | $m->checkSourceAuth() or $m->error('errSrcAuth'); 37 | 38 | if ($action eq 'old') { 39 | # Mark messages as old by setting prevOnTime 40 | $m->{userUpdates}{prevOnTime} = $time; 41 | $m->setCookie('prevon', $time); 42 | 43 | # Log action and finish 44 | $m->logAction(1, 'user', 'markold', $userId); 45 | $m->redirect('forum_show', msg => 'MarkOld'); 46 | } 47 | elsif ($action eq 'read') { 48 | if ($boardId) { 49 | # Mark all unread topics read 50 | my $lowestUnreadTime = $m->{now} - $cfg->{maxUnreadDays} * 86400; 51 | my $tmp = 'userMark' . int(rand(2147483647)); 52 | $m->dbDo(" 53 | CREATE TEMPORARY TABLE $tmp AS 54 | SELECT topics.id AS id 55 | FROM topics AS topics 56 | LEFT JOIN topicReadTimes AS topicReadTimes 57 | ON topicReadTimes.userId = :userId 58 | AND topicReadTimes.topicId = topics.id 59 | WHERE topics.boardId = :boardId 60 | AND topics.lastPostTime > :lowestUnreadTime 61 | AND (topics.lastPostTime > topicReadTimes.lastReadTime 62 | OR topicReadTimes.topicId IS NULL)", 63 | { userId => $userId, boardId => $boardId, lowestUnreadTime => $lowestUnreadTime }); 64 | $m->dbDo(" 65 | DELETE FROM topicReadTimes WHERE userId = ? AND topicId IN (SELECT id FROM $tmp)", 66 | $userId); 67 | $m->dbDo(" 68 | INSERT INTO topicReadTimes SELECT ?, id, ? FROM $tmp", $userId, $m->{now}); 69 | $m->dbDo(" 70 | DROP TABLE $tmp"); 71 | } 72 | else { 73 | # Mark everything read by setting fakeReadTime 74 | $m->{userUpdates}{fakeReadTime} = $time; 75 | $m->dbDo(" 76 | DELETE FROM topicReadTimes WHERE userId = ?", $userId); 77 | } 78 | 79 | # Log action and finish 80 | $m->logAction(1, 'user', 'markread', $userId, $boardId); 81 | $m->redirect('forum_show', msg => 'MarkRead'); 82 | } 83 | } 84 | else { 85 | if ($action eq 'old') { 86 | # Mark messages as old by setting prevOnTime in cookie 87 | $m->setCookie('prevon', $time); 88 | 89 | # Log action and finish 90 | $m->logAction(2, 'guest', 'markold'); 91 | $m->redirect('forum_show', msg => 'MarkOld'); 92 | } 93 | else { 94 | $m->error('errNoAccess'); 95 | } 96 | } 97 | -------------------------------------------------------------------------------- /script/user_wipe.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | #------------------------------------------------------------------------------ 3 | # mwForum - Web-based discussion forum 4 | # Copyright (c) 1999-2015 Markus Wichitill 5 | # 6 | # This program is free software; you can redistribute it and/or modify 7 | # it under the terms of the GNU General Public License as published by 8 | # the Free Software Foundation; either version 3 of the License, or 9 | # (at your option) any later version. 10 | # 11 | # This program is distributed in the hope that it will be useful, 12 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | # GNU General Public License for more details. 15 | #------------------------------------------------------------------------------ 16 | 17 | use strict; 18 | use warnings; 19 | no warnings qw(uninitialized redefine); 20 | 21 | # Imports 22 | use MwfMain; 23 | 24 | #------------------------------------------------------------------------------ 25 | 26 | # Init 27 | my ($m, $cfg, $lng, $user, $userId) = MwfMain->new($_[0]); 28 | 29 | # Check if user is admin 30 | $user->{admin} or $m->error('errNoAccess'); 31 | 32 | # Get CGI parameters 33 | my $wipeUserId = $m->paramInt('uid'); 34 | my $submitted = $m->paramBool('subm'); 35 | $wipeUserId or $m->error('errParamMiss'); 36 | 37 | # Get user 38 | my $wipeUser = $m->getUser($wipeUserId); 39 | $wipeUser or $m->error('errUsrNotFnd'); 40 | !$wipeUser->{admin} or $m->error("Wiping admins is not allowed for security reasons."); 41 | 42 | # Process form 43 | if ($submitted) { 44 | # Check request source authentication 45 | $m->checkSourceAuth() or $m->formError('errSrcAuth'); 46 | 47 | # If there's no error, finish action 48 | if (!@{$m->{formErrors}}) { 49 | # Wipe user 50 | $m->deleteUser($wipeUserId, 1); 51 | 52 | # Log action and finish 53 | $m->logAction(1, 'user', 'wipe', $userId, 0, 0, 0, $wipeUserId); 54 | $m->redirect('user_info', uid => $wipeUserId); 55 | } 56 | } 57 | 58 | # Print form 59 | if (!$submitted || @{$m->{formErrors}}) { 60 | # Print header 61 | $m->printHeader(); 62 | 63 | # Print page bar 64 | my @navLinks = ({ url => $m->url('user_info', uid => $wipeUserId), txt => 'comUp', ico => 'up' }); 65 | $m->printPageBar(mainTitle => "User", subTitle => $wipeUser->{userName}, navLinks => \@navLinks); 66 | 67 | # Print hints and form errors 68 | $m->printHints([ 69 | "Wiping a user account means clearing all profile fields, resetting Email, Password and OpenID". 70 | " (making login impossible), and deleting various related entries from other database tables.". 71 | " The account itself remains, and the Real Name, Email and OpenID fields will be copied into". 72 | " the Comments field (only visible to admins). Useful when a user wants to be deleted, but". 73 | " when that is undesirable for accountability reasons."]); 74 | $m->printFormErrors(); 75 | 76 | # Print notification message form 77 | print 78 | "
\n", 79 | "
\n", 80 | "
Wipe User
\n", 81 | "
\n", 82 | $m->submitButton("Wipe", 'wipe'), 83 | "\n", 84 | $m->stdFormFields(), 85 | "
\n", 86 | "
\n", 87 | "
\n\n"; 88 | 89 | # Log action and finish 90 | $m->logAction(3, 'user', 'wipe', $userId, 0, 0, 0, $wipeUserId); 91 | $m->printFooter(); 92 | } 93 | $m->finish(); 94 | -------------------------------------------------------------------------------- /script/chat_show.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | #------------------------------------------------------------------------------ 3 | # mwForum - Web-based discussion forum 4 | # Copyright (c) 1999-2015 Markus Wichitill 5 | # 6 | # This program is free software; you can redistribute it and/or modify 7 | # it under the terms of the GNU General Public License as published by 8 | # the Free Software Foundation; either version 3 of the License, or 9 | # (at your option) any later version. 10 | # 11 | # This program is distributed in the hope that it will be useful, 12 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | # GNU General Public License for more details. 15 | #------------------------------------------------------------------------------ 16 | 17 | use strict; 18 | use warnings; 19 | no warnings qw(uninitialized redefine); 20 | 21 | # Imports 22 | use MwfMain; 23 | 24 | #------------------------------------------------------------------------------ 25 | 26 | # Init 27 | my ($m, $cfg, $lng, $user, $userId) = MwfMain->new($_[0]); 28 | 29 | # Check if access should be denied 30 | $cfg->{chat} or $m->error('errNoAccess'); 31 | $cfg->{chat} != 2 || $userId or $m->error('errNoAccess'); 32 | 33 | # Update user's read time 34 | $m->{userUpdates}{chatReadTime} = $m->{now} if $userId; 35 | 36 | # Print header 37 | $m->printHeader(); 38 | 39 | # Print page bar 40 | my @navLinks = ({ url => $m->url('forum_show'), txt => 'comUp', ico => 'up' }); 41 | my @userLinks = (); 42 | push @userLinks, { url => $m->url('chat_show'), txt => 'chtRefresh', ico => 'refresh' }; 43 | push @userLinks, { url => $m->url('user_confirm', script => 'chat_delete', act => 'all'), 44 | txt => 'chtDelAll', ico => 'delete' } 45 | if $user->{admin}; 46 | $m->printPageBar(mainTitle => $lng->{chtTitle}, navLinks => \@navLinks, userLinks => \@userLinks); 47 | 48 | # Get chat messages 49 | my $chatReadTime = $user->{chatReadTime} || 2147483647; 50 | my $chats = $m->fetchAllHash(" 51 | SELECT chat.*, chat.postTime > :chatReadTime AS unread, 52 | users.userName 53 | FROM chat AS chat 54 | INNER JOIN users AS users 55 | ON users.id = chat.userId 56 | ORDER BY chat.id DESC 57 | LIMIT :chatMaxMsgs", 58 | { chatReadTime => $chatReadTime, chatMaxMsgs => $cfg->{chatMaxMsgs} }); 59 | 60 | # Print chat input field 61 | print 62 | "
\n", 63 | "
\n", 64 | "
$lng->{chtAddTtl}
\n", 65 | "
\n", 66 | "\n", 67 | $m->submitButton('chtAddB', 'write'), 68 | $m->stdFormFields(), 69 | "
\n", 70 | "
\n", 71 | "
\n\n", 72 | if $userId; 73 | 74 | # Print chat messages 75 | print 76 | "
\n", 77 | "
$lng->{chtMsgsTtl}
\n"; 78 | 79 | for my $chat (@$chats) { 80 | # Format output 81 | my $url = $m->url('user_info', uid => $chat->{userId}); 82 | my $userNameStr = "$chat->{userName}"; 83 | my $shortTimeStr = $m->formatTime($chat->{postTime}, $user->{timezone}, "%H:%M"); 84 | $shortTimeStr = "$shortTimeStr" if $chat->{unread}; 85 | 86 | print 87 | "
\n", 88 | "$userNameStr $shortTimeStr> ", $chat->{body}, "\n", 89 | "
\n"; 90 | } 91 | 92 | print "
\n\n"; 93 | 94 | # Log action and finish 95 | $m->logAction(2, 'chat', 'show', $userId); 96 | $m->printFooter(); 97 | $m->finish(); 98 | -------------------------------------------------------------------------------- /script/message_export.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | #------------------------------------------------------------------------------ 3 | # mwForum - Web-based discussion forum 4 | # Copyright (c) 1999-2015 Markus Wichitill 5 | # 6 | # This program is free software; you can redistribute it and/or modify 7 | # it under the terms of the GNU General Public License as published by 8 | # the Free Software Foundation; either version 3 of the License, or 9 | # (at your option) any later version. 10 | # 11 | # This program is distributed in the hope that it will be useful, 12 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | # GNU General Public License for more details. 15 | #------------------------------------------------------------------------------ 16 | 17 | use strict; 18 | use warnings; 19 | no warnings qw(uninitialized redefine); 20 | 21 | # Imports 22 | use MwfMain; 23 | 24 | #------------------------------------------------------------------------------ 25 | 26 | # Init 27 | my ($m, $cfg, $lng, $user, $userId) = MwfMain->new($_[0]); 28 | 29 | # Check if access should be denied 30 | $cfg->{messages} or $m->error('errNoAccess'); 31 | $userId or $m->error('errNoAccess'); 32 | 33 | # Get messages 34 | my $messages = $m->fetchAllHash(" 35 | SELECT messages.*, 36 | senders.userName AS senderName, 37 | receivers.userName AS receiverName 38 | FROM messages AS messages 39 | INNER JOIN users AS senders 40 | ON senders.id = messages.senderId 41 | INNER JOIN users AS receivers 42 | ON receivers.id = messages.receiverId 43 | WHERE (messages.senderId = :userId AND messages.sentbox = 1) 44 | OR (messages.receiverId = :userId AND messages.inbox = 1) 45 | ORDER BY messages.sendTime DESC", 46 | { userId => $userId }); 47 | 48 | # Print header 49 | $m->printHttpHeader({ 'content-disposition' => "attachment; filename=Messages.html" }); 50 | my $fontFaceStr = $user->{fontFace} ? "font-family: '$user->{fontFace}', sans-serif;" : ""; 51 | my $fontSizeStr = $user->{fontSize} ? "font-size: $user->{fontSize}px;" : ""; 52 | print 53 | "\n", 54 | "\n", 55 | "\n", 56 | "$lng->{mslTitle}\n", 57 | "\n", 58 | "\n", 66 | "\n", 67 | "\n\n"; 68 | 69 | # Print messages 70 | for my $msg (@$messages) { 71 | # Print message 72 | my $subject = $msg->{subject}; 73 | $subject =~ s!Re: !!; 74 | my $time = $m->formatTime($msg->{sendTime}, $user->{timezone}); 75 | my $timeIso = $m->formatTime($msg->{sendTime}, 0, "%Y-%m-%dT%TZ"); 76 | print 77 | "
\n", 78 | "
\n", 79 | "

$subject

\n", 80 | "\n", 81 | "\n", 82 | "\n", 83 | "\n", 84 | "
$lng->{mssFrom}$msg->{senderName}
$lng->{mssTo}$msg->{receiverName}
$lng->{mssDate}
\n", 85 | "
\n", 86 | "
\n$msg->{body}\n
\n", 87 | "
\n\n"; 88 | } 89 | 90 | print 91 | "\n", 92 | "\n"; 93 | 94 | # Log action and finish 95 | $m->logAction(2, 'msg', 'export', $userId); 96 | $m->finish(); 97 | -------------------------------------------------------------------------------- /util/util_replace.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | #------------------------------------------------------------------------------ 3 | # mwForum - Web-based discussion forum 4 | # Copyright (c) 1999-2015 Markus Wichitill 5 | # 6 | # This program is free software; you can redistribute it and/or modify 7 | # it under the terms of the GNU General Public License as published by 8 | # the Free Software Foundation; either version 3 of the License, or 9 | # (at your option) any later version. 10 | # 11 | # This program is distributed in the hope that it will be useful, 12 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | # GNU General Public License for more details. 15 | #------------------------------------------------------------------------------ 16 | 17 | # Search and replace text in mwForum database fields. 18 | 19 | use strict; 20 | use warnings; 21 | no warnings qw(uninitialized); 22 | 23 | # Imports 24 | use Getopt::Std (); 25 | require MwfMain; 26 | 27 | # Get arguments 28 | my %opts = (); 29 | Getopt::Std::getopts('?hxiquf:t:c:', \%opts); 30 | my $help = $opts{'?'} || $opts{h}; 31 | my $execute = $opts{x}; 32 | my $caseIns = $opts{i}; 33 | my $quiet = $opts{q}; 34 | my $mysqlUseResult = $opts{u}; 35 | my $forumId = $opts{f}; 36 | my $table = $opts{t} || 'posts'; 37 | my $col = $opts{c} || 'body'; 38 | my $txt1 = $ARGV[0]; 39 | my $txt2 = $ARGV[1]; 40 | usage() if $help || !length($txt1); 41 | 42 | # Init 43 | my ($m, $cfg, $lng) = MwfMain->newShell(forumId => $forumId); 44 | $m->{dbh}{mysql_use_result} = 1 if $mysqlUseResult; 45 | 46 | # Decode UTF-8 or treat as Latin1 47 | utf8::decode($txt1) or utf8::upgrade($txt1); 48 | utf8::decode($txt2) or utf8::upgrade($txt2); 49 | 50 | # Search and replace 51 | $m->dbBegin(); 52 | my $sum = 0; 53 | my $switch = $caseIns ? "(?i)" : ""; 54 | my $updSth = $m->dbPrepare(" 55 | UPDATE $table SET $col = ? WHERE id = ?"); 56 | my $selSth = $m->fetchSth(" 57 | SELECT id, $col FROM $table"); 58 | my ($id, $body); 59 | $selSth->bind_columns(\($id, $body)); 60 | while ($selSth->fetch()) { 61 | utf8::decode($body); 62 | my $num = $body =~ s!$switch$txt1!$txt2!go; 63 | $sum += $num; 64 | if ($execute && $num) { 65 | # Replace 66 | $m->dbExecute($updSth, $body, $id); 67 | print "Replaced $num occurrences in #$id\n" if !$quiet; 68 | } 69 | else { 70 | # Print occurrences only 71 | print "Found $num occurrences in #$id\n" if !$quiet && $num; 72 | } 73 | } 74 | $m->dbCommit(); 75 | 76 | # Print sum of occurrences 77 | my $verb = $execute ? "Replaced" : "Found"; 78 | print "$verb $sum occurrences\n"; 79 | 80 | #------------------------------------------------------------------------------ 81 | 82 | sub usage 83 | { 84 | print 85 | "\nSearch and replace in database fields.\n\n", 86 | "Usage: util_replace.pl [-xiq] [-f forum] [-t table] [-c column] [--] searchExp [replaceExp]\n", 87 | " -x Execute replacements. Otherwise, only number of occurrences is printed.\n", 88 | " -i Search-expression is case-insensitive.\n", 89 | " -q Quiet, print summary only.\n", 90 | " -f Forum hostname or URL path when using a multi-forum installation.\n", 91 | " -t Table name, default: posts.\n", 92 | " -c Column name, default: body.\n", 93 | "\nNotes:\n", 94 | " - searchExp is a regular expression.\n", 95 | " - replaceExp cannot use backreferences.\n", 96 | " - Can only be used on tables with an 'id' field.\n", 97 | " - Non-ASCII characters may not work if not passed as UTF-8 or Latin1.\n", 98 | ; 99 | 100 | exit 1; 101 | } 102 | -------------------------------------------------------------------------------- /script/post_delete.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | #------------------------------------------------------------------------------ 3 | # mwForum - Web-based discussion forum 4 | # Copyright (c) 1999-2015 Markus Wichitill 5 | # 6 | # This program is free software; you can redistribute it and/or modify 7 | # it under the terms of the GNU General Public License as published by 8 | # the Free Software Foundation; either version 3 of the License, or 9 | # (at your option) any later version. 10 | # 11 | # This program is distributed in the hope that it will be useful, 12 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | # GNU General Public License for more details. 15 | #------------------------------------------------------------------------------ 16 | 17 | use strict; 18 | use warnings; 19 | no warnings qw(uninitialized redefine); 20 | 21 | # Imports 22 | use MwfMain; 23 | 24 | #------------------------------------------------------------------------------ 25 | 26 | # Init 27 | my ($m, $cfg, $lng, $user, $userId) = MwfMain->new($_[0]); 28 | 29 | # Get CGI parameters 30 | my $postId = $m->paramInt('pid'); 31 | my $notify = $m->paramBool('notify'); 32 | my $reason = $m->paramStr('reason'); 33 | $postId or $m->error('errParamMiss'); 34 | 35 | # Check request source authentication 36 | $m->checkSourceAuth() or $m->error('errSrcAuth'); 37 | 38 | # Get post 39 | my $post = $m->fetchHash(" 40 | SELECT posts.*, 41 | topics.pollId, topics.subject 42 | FROM posts AS posts 43 | INNER JOIN topics AS topics 44 | ON topics.id = posts.topicId 45 | WHERE posts.id = ?", $postId); 46 | $post or $m->error('errPstNotFnd'); 47 | my $boardId = $post->{boardId}; 48 | my $topicId = $post->{topicId}; 49 | 50 | # Get board 51 | my $board = $m->fetchHash(" 52 | SELECT * FROM boards WHERE id = ?", $boardId); 53 | 54 | # Check if user can see and write to board 55 | my $boardAdmin = $user->{admin} || $m->boardAdmin($userId, $boardId) 56 | || $board->{topicAdmins} && $m->topicAdmin($userId, $topicId); 57 | $boardAdmin || $m->boardVisible($board) or $m->error('errNoAccess'); 58 | $boardAdmin || $m->boardWritable($board, 1) or $m->error('errNoAccess'); 59 | 60 | # Check if user owns post or is moderator 61 | $userId && $userId == $post->{userId} || $boardAdmin or $m->error('errNoAccess'); 62 | 63 | # Check editing time limitation 64 | !$cfg->{postEditTime} || $m->{now} < $post->{postTime} + $cfg->{postEditTime} 65 | || $boardAdmin || $m->boardMember($userId, $boardId) 66 | or $m->error('errPstEdtTme'); 67 | 68 | # Check if topic or post is locked 69 | !$m->fetchArray(" 70 | SELECT locked FROM topics WHERE id = ?", $topicId) 71 | || $boardAdmin or $m->error('errTpcLocked'); 72 | !$post->{locked} || $boardAdmin or $m->error('errPstLocked'); 73 | 74 | # Check authorization 75 | $m->checkAuthz($user, 'deletePost'); 76 | 77 | # Delete post 78 | my $trash = $cfg->{trashBoardId} && $cfg->{trashBoardId} != $boardId; 79 | my $topicDeleted = $m->deletePost($postId, $trash); 80 | $m->recalcStats($boardId, $topicId); 81 | 82 | # Add notification message 83 | if ($notify && $post->{userId} && $post->{userId} != $userId) { 84 | if ($topicDeleted) { 85 | $m->addNote('tpcDel', $post->{userId}, 'notTpcDel', tpcSbj => $post->{subject}, reason => $reason); 86 | } 87 | else { 88 | my $url = "topic_show$m->{ext}?tid=$topicId"; 89 | $m->addNote('pstDel', $post->{userId}, 'notPstDel', tpcUrl => $url, reason => $reason); 90 | } 91 | } 92 | 93 | # Log action and finish 94 | $m->logAction(1, 'post', 'delete', $userId, $boardId, $topicId, $postId); 95 | $m->redirect('board_show', bid => $boardId, msg => 'PstTpcDel') if $topicDeleted; 96 | $m->redirect('topic_show', $post->{parentId} ? (pid => $post->{parentId}) : (tid => $topicId), 97 | msg => 'PstDel'); 98 | -------------------------------------------------------------------------------- /script/board_archive.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | #------------------------------------------------------------------------------ 3 | # mwForum - Web-based discussion forum 4 | # Copyright (c) 1999-2015 Markus Wichitill 5 | # 6 | # This program is free software; you can redistribute it and/or modify 7 | # it under the terms of the GNU General Public License as published by 8 | # the Free Software Foundation; either version 3 of the License, or 9 | # (at your option) any later version. 10 | # 11 | # This program is distributed in the hope that it will be useful, 12 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | # GNU General Public License for more details. 15 | #------------------------------------------------------------------------------ 16 | 17 | use strict; 18 | use warnings; 19 | no warnings qw(uninitialized redefine); 20 | 21 | # Imports 22 | use MwfMain; 23 | 24 | #------------------------------------------------------------------------------ 25 | 26 | # Init 27 | my ($m, $cfg, $lng, $user, $userId) = MwfMain->new($_[0]); 28 | 29 | # Check if user is admin 30 | $user->{admin} or $m->error('errNoAccess'); 31 | 32 | # Get CGI parameters 33 | my $boardId = $m->paramInt('bid'); 34 | my $submitted = $m->paramBool('subm'); 35 | $boardId or $m->error('errParamMiss'); 36 | 37 | # Get board 38 | my $boardTitle = $m->fetchArray(" 39 | SELECT title FROM boards WHERE id = ?", $boardId); 40 | $boardTitle or $m->error('errBrdNotFnd'); 41 | 42 | # Process form 43 | if ($submitted) { 44 | # Check request source authentication 45 | $m->checkSourceAuth() or $m->formError('errSrcAuth'); 46 | 47 | # If there's no error, finish action 48 | if (!@{$m->{formErrors}}) { 49 | # Delete old archive contents 50 | $m->dbDo(" 51 | DELETE FROM arc_boards WHERE id = ?", $boardId); 52 | $m->dbDo(" 53 | DELETE FROM arc_topics WHERE boardId = ?", $boardId); 54 | $m->dbDo(" 55 | DELETE FROM arc_posts WHERE boardId = ?", $boardId); 56 | 57 | # Copy boards, topics and posts 58 | $m->dbDo(" 59 | INSERT INTO arc_boards 60 | SELECT * FROM boards WHERE id = ?", $boardId); 61 | $m->dbDo(" 62 | INSERT INTO arc_topics 63 | SELECT * FROM topics WHERE boardId = ?", $boardId); 64 | $m->dbDo(" 65 | INSERT INTO arc_posts 66 | SELECT * FROM posts WHERE boardId = ?", $boardId); 67 | 68 | # Log action and finish 69 | $m->logAction(1, 'board', 'archive', $userId, $boardId); 70 | $m->redirect('board_show', bid => $boardId); 71 | } 72 | } 73 | 74 | # Print forms 75 | if (!$submitted || @{$m->{formErrors}}) { 76 | # Print header 77 | $m->printHeader(); 78 | 79 | # Print page bar 80 | my @navLinks = ({ url => $m->url('board_show', bid => $boardId), txt => 'comUp', ico => 'up' }); 81 | $m->printPageBar(mainTitle => "Board", subTitle => $boardTitle, navLinks => \@navLinks); 82 | 83 | # Print hints and form errors 84 | $m->printHints(["Archiving a board copies the board and its topics and posts into separate". 85 | " archive tables. Archiving a board that has been archived before will delete the old". 86 | " archive contents. See FAQ.html for details."]); 87 | $m->printFormErrors(); 88 | 89 | # Print form 90 | print 91 | "
\n", 92 | "
\n", 93 | "
Archive Board
\n", 94 | "
\n", 95 | $m->submitButton("Archive", 'archive'), 96 | "\n", 97 | $m->stdFormFields(), 98 | "
\n", 99 | "
\n", 100 | "
\n\n"; 101 | 102 | # Log action and finish 103 | $m->logAction(3, 'board', 'archive', $userId, $boardId); 104 | $m->printFooter(); 105 | } 106 | $m->finish(); 107 | -------------------------------------------------------------------------------- /script/board_merge.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | #------------------------------------------------------------------------------ 3 | # mwForum - Web-based discussion forum 4 | # Copyright (c) 1999-2015 Markus Wichitill 5 | # 6 | # This program is free software; you can redistribute it and/or modify 7 | # it under the terms of the GNU General Public License as published by 8 | # the Free Software Foundation; either version 3 of the License, or 9 | # (at your option) any later version. 10 | # 11 | # This program is distributed in the hope that it will be useful, 12 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | # GNU General Public License for more details. 15 | #------------------------------------------------------------------------------ 16 | 17 | use strict; 18 | use warnings; 19 | no warnings qw(uninitialized redefine); 20 | 21 | # Imports 22 | use MwfMain; 23 | 24 | #------------------------------------------------------------------------------ 25 | 26 | # Init 27 | my ($m, $cfg, $lng, $user, $userId) = MwfMain->new($_[0]); 28 | 29 | # Check if user is admin 30 | $user->{admin} or $m->error('errNoAccess'); 31 | 32 | # Get CGI parameters 33 | my $oldBoardId = $m->paramInt('bid'); 34 | my $newBoardId = $m->paramInt('newBoardId'); 35 | my $submitted = $m->paramBool('subm'); 36 | $oldBoardId or $m->error('errParamMiss'); 37 | 38 | # Get board 39 | my $boardTitle = $m->fetchArray(" 40 | SELECT title FROM boards WHERE id = ?", $oldBoardId); 41 | $boardTitle or $m->error('errBrdNotFnd'); 42 | 43 | # Process form 44 | if ($submitted) { 45 | # Check request source authentication 46 | $m->checkSourceAuth() or $m->formError('errSrcAuth'); 47 | 48 | # Check if new board selected 49 | $newBoardId or $m->formError("No board selected."); 50 | 51 | # If there's no error, finish action 52 | if (!@{$m->{formErrors}}) { 53 | # Update posts, topics and board 54 | $m->dbDo(" 55 | UPDATE posts SET boardId = ? WHERE boardId = ?", $newBoardId, $oldBoardId); 56 | $m->dbDo(" 57 | UPDATE topics SET boardId = ? WHERE boardId = ?", $newBoardId, $oldBoardId); 58 | $m->recalcStats([ $oldBoardId, $newBoardId ]); 59 | 60 | # Log action and finish 61 | $m->logAction(1, 'board', 'merge', $userId, $oldBoardId, 0, 0, $newBoardId); 62 | $m->redirect('board_show', bid => $oldBoardId); 63 | } 64 | } 65 | 66 | # Print forms 67 | if (!$submitted || @{$m->{formErrors}}) { 68 | # Print header 69 | $m->printHeader(); 70 | 71 | # Print page bar 72 | my @navLinks = ({ url => $m->url('board_show', bid => $oldBoardId), 73 | txt => 'comUp', ico => 'up' }); 74 | $m->printPageBar(mainTitle => "Board", subTitle => $boardTitle, navLinks => \@navLinks); 75 | 76 | # Print hints and form errors 77 | $m->printFormErrors(); 78 | 79 | # Get boards 80 | my $boards = $m->fetchAllHash(" 81 | SELECT boards.id, boards.title, 82 | categories.title AS categTitle 83 | FROM boards AS boards 84 | INNER JOIN categories AS categories 85 | ON categories.id = boards.categoryId 86 | ORDER BY categories.pos, boards.pos"); 87 | 88 | # Print destination board form 89 | print 90 | "
\n", 91 | "
\n", 92 | "
Merge Boards
\n", 93 | "
\n", 94 | "\n", 98 | $m->submitButton("Merge", 'merge'), 99 | "\n", 100 | $m->stdFormFields(), 101 | "
\n", 102 | "
\n", 103 | "
\n\n"; 104 | 105 | # Log action and finish 106 | $m->logAction(3, 'board', 'merge', $userId, $oldBoardId); 107 | $m->printFooter(); 108 | } 109 | $m->finish(); 110 | -------------------------------------------------------------------------------- /script/user_confirm.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | #------------------------------------------------------------------------------ 3 | # mwForum - Web-based discussion forum 4 | # Copyright (c) 1999-2015 Markus Wichitill 5 | # 6 | # This program is free software; you can redistribute it and/or modify 7 | # it under the terms of the GNU General Public License as published by 8 | # the Free Software Foundation; either version 3 of the License, or 9 | # (at your option) any later version. 10 | # 11 | # This program is distributed in the hope that it will be useful, 12 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | # GNU General Public License for more details. 15 | #------------------------------------------------------------------------------ 16 | 17 | use strict; 18 | use warnings; 19 | no warnings qw(uninitialized redefine); 20 | 21 | # Imports 22 | use MwfMain; 23 | 24 | #------------------------------------------------------------------------------ 25 | 26 | # Init 27 | my ($m, $cfg, $lng, $user, $userId) = MwfMain->new($_[0]); 28 | 29 | # Get CGI parameters 30 | my ($script) = $m->paramStr('script') =~ /^([A-Za-z_0-9]+)\z/; 31 | my $act = $m->paramStrId('act'); 32 | my $uid = $m->paramInt('uid'); 33 | my $gid = $m->paramInt('gid'); 34 | my $cid = $m->paramInt('cid'); 35 | my $bid = $m->paramInt('bid'); 36 | my $tid = $m->paramInt('tid'); 37 | my $pid = $m->paramInt('pid'); 38 | my $mid = $m->paramInt('mid'); 39 | my $pollId = $m->paramInt('pollId'); 40 | my $name = $m->paramStr('name'); 41 | my $notify = $m->paramBool('notify'); 42 | 43 | # Print header 44 | $m->printHeader(); 45 | 46 | # Determine entity type 47 | my $entity = ""; 48 | if ($pollId) { $entity = $lng->{cnfTypePoll} } 49 | elsif ($uid) { $entity = $lng->{cnfTypeUser} } 50 | elsif ($gid) { $entity = $lng->{cnfTypeGroup} } 51 | elsif ($cid) { $entity = $lng->{cnfTypeCateg} } 52 | elsif ($bid) { $entity = $lng->{cnfTypeBoard} } 53 | elsif ($tid) { $entity = $lng->{cnfTypeTopic} } 54 | elsif ($pid) { $entity = $lng->{cnfTypePost} } 55 | elsif ($mid) { $entity = $lng->{cnfTypeMsg} } 56 | 57 | # Determine question 58 | my $question = ""; 59 | if ($script eq 'post_attach') { 60 | $question = $lng->{cnfDelAllAtt}; 61 | } 62 | elsif ($entity) { 63 | my $nameEsc = $m->escHtml($m->deescHtml($name)); 64 | $question = "$lng->{cnfQuestion} $entity \"$nameEsc\"$lng->{cnfQuestion2}"; 65 | } 66 | elsif ($script eq 'message_delete') { 67 | $question = $lng->{cnfDelAllMsg}; 68 | } 69 | elsif ($script eq 'chat_delete') { 70 | $question = $lng->{cnfDelAllCht}; 71 | } 72 | 73 | # Print confirmation form 74 | print 75 | "
\n", 76 | "
\n", 77 | "
$lng->{cnfTitle}
\n", 78 | "
\n", 79 | "

$question

\n"; 80 | 81 | # Print notification section 82 | my $noteChk = $cfg->{noteDefMod} ? 'checked' : ""; 83 | print 84 | "
\n", 85 | "
\n", 87 | "\n", 88 | map("\n", 90 | "\n", 91 | "
\n" 92 | if $notify; 93 | 94 | print 95 | $m->submitButton('cnfDeleteB', 'delete'), 96 | "\n", 97 | "\n", 98 | "\n", 99 | "\n", 100 | "\n", 101 | "\n", 102 | "\n", 103 | "\n", 104 | "\n", 105 | $m->stdFormFields(), 106 | "
\n", 107 | "
\n", 108 | "
\n\n"; 109 | 110 | # Print footer 111 | $m->printFooter(); 112 | $m->finish(); 113 | -------------------------------------------------------------------------------- /script/spawn_upgrade.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | #------------------------------------------------------------------------------ 3 | # mwForum - Web-based discussion forum 4 | # Copyright (c) 1999-2015 Markus Wichitill 5 | # 6 | # This program is free software; you can redistribute it and/or modify 7 | # it under the terms of the GNU General Public License as published by 8 | # the Free Software Foundation; either version 3 of the License, or 9 | # (at your option) any later version. 10 | # 11 | # This program is distributed in the hope that it will be useful, 12 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | # GNU General Public License for more details. 15 | #------------------------------------------------------------------------------ 16 | 17 | use strict; 18 | use warnings; 19 | no warnings qw(uninitialized redefine); 20 | 21 | # Imports 22 | use MwfMain; 23 | 24 | #------------------------------------------------------------------------------ 25 | 26 | # Init 27 | my ($m, $cfg, $lng, $user, $userId) = MwfMain->new($_[0]); 28 | 29 | # Check if user is admin 30 | $user->{admin} or $m->error('errNoAccess'); 31 | 32 | # Get CGI parameters 33 | my $test = $m->paramBool('test'); 34 | my $upgrade = $m->paramBool('upgrade'); 35 | my $wipe = $m->paramBool('wipe'); 36 | my $submitted = $m->paramBool('subm'); 37 | 38 | # Process form 39 | if ($submitted) { 40 | # Check request source authentication 41 | $m->checkSourceAuth() or $m->formError('errSrcAuth'); 42 | 43 | # If there's no error, finish action 44 | if (!@{$m->{formErrors}}) { 45 | if ($upgrade) { $m->spawnScript('upgrade') } 46 | elsif ($test) { $m->spawnScript('spawn_test') } 47 | elsif ($wipe) { 48 | # Wipe last output 49 | $m->dbDo(" 50 | DELETE FROM variables WHERE name = ?", 'upgOutput'); 51 | } 52 | 53 | # Redirect to same page 54 | $m->redirect('spawn_upgrade'); 55 | } 56 | } 57 | 58 | # Print form 59 | if (!$submitted || @{$m->{formErrors}}) { 60 | # Print header 61 | $m->printHeader(); 62 | 63 | # Print page bar 64 | my @navLinks = ({ url => $m->url('forum_show'), txt => 'comUp', ico => 'up' }); 65 | $m->printPageBar(mainTitle => "Upgrade", navLinks => \@navLinks); 66 | 67 | # Print hints and form errors 68 | $m->printHints([ 69 | "This method of starting upgrade.pl over the browser requires the" 70 | . " \$cfg->{scriptFsPath} and \$cfg->{perlBinary}" 71 | . " options to be set up. The output below may be from the previous upgrade." 72 | . " Execution may take a while." 73 | . " Only if the output ends with 'mwForum upgrade done' has upgrade.pl run to completion." 74 | . " As it is run in the background, it should not get interrupted by any webserver" 75 | . " timeouts, though some webhosters may kill any script that runs for too long." 76 | . " Use Test to check if a script can run for 20 minutes." 77 | . " Refresh occasionally to check if scripts are done." 78 | ]); 79 | $m->printFormErrors(); 80 | 81 | # Print execution form 82 | print 83 | "
\n", 84 | "
Execute
\n", 85 | "
\n", 86 | "
\n", 87 | "
\n", 88 | $m->submitButton("Test", 'admopt', 'test'), 89 | $m->submitButton("Upgrade", 'admopt', 'upgrade'), 90 | $m->submitButton("Wipe Output", 'delete', 'wipe'), 91 | $m->stdFormFields(), 92 | "
\n", 93 | "
\n", 94 | "
\n", 95 | "
\n\n"; 96 | 97 | # Print last upgrade output 98 | my $output = $m->fetchArray(" 99 | SELECT value FROM variables WHERE name = ?", 'upgOutput'); 100 | my $outputEsc = $m->escHtml($output, 1); 101 | $outputEsc =~ s!(Error:)!$1!g; 102 | my $refreshUrl = $m->url('spawn_upgrade'); 103 | print 104 | "
\n", 105 | "
Last Output", 106 | " | Refresh
\n", 107 | "
\n", 108 | "
$outputEsc
\n", 109 | "
\n", 110 | "
\n\n"; 111 | 112 | # Log action and finish 113 | $m->logAction(3, 'spawn', 'upgrade', $userId); 114 | $m->printFooter(); 115 | } 116 | $m->finish(); 117 | -------------------------------------------------------------------------------- /script/user_migrate.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | #------------------------------------------------------------------------------ 3 | # mwForum - Web-based discussion forum 4 | # Copyright (c) 1999-2015 Markus Wichitill 5 | # 6 | # This program is free software; you can redistribute it and/or modify 7 | # it under the terms of the GNU General Public License as published by 8 | # the Free Software Foundation; either version 3 of the License, or 9 | # (at your option) any later version. 10 | # 11 | # This program is distributed in the hope that it will be useful, 12 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | # GNU General Public License for more details. 15 | #------------------------------------------------------------------------------ 16 | 17 | use strict; 18 | use warnings; 19 | no warnings qw(uninitialized redefine); 20 | 21 | # Imports 22 | use MwfMain; 23 | 24 | #------------------------------------------------------------------------------ 25 | 26 | # Init 27 | my ($m, $cfg, $lng, $user, $userId) = MwfMain->new($_[0], autocomplete => 1); 28 | 29 | # Check if user is admin 30 | $user->{admin} or $m->error('errNoAccess'); 31 | 32 | # Get CGI parameters 33 | my $oldUserId = $m->paramInt('uid'); 34 | my $newUserId = $m->paramInt('newUserId'); 35 | my $userName = $m->paramStr('userName'); 36 | my $submitted = $m->paramBool('subm'); 37 | $oldUserId or $m->error('errParamMiss'); 38 | 39 | # Process form 40 | if ($submitted) { 41 | # Check request source authentication 42 | $m->checkSourceAuth() or $m->formError('errSrcAuth'); 43 | 44 | # Check if old users exist 45 | $m->fetchArray(" 46 | SELECT id FROM users WHERE id = ?", $oldUserId) 47 | or $m->formError('errUsrNotFnd'); 48 | 49 | # Check if user exists or get user id from name 50 | if ($newUserId) { 51 | $m->fetchArray(" 52 | SELECT 1 FROM users WHERE id = ?", $newUserId) 53 | or $m->formError('errUsrNotFnd'); 54 | } 55 | else { 56 | $newUserId = $m->fetchArray(" 57 | SELECT id FROM users WHERE userName = ?", $userName); 58 | $newUserId or $m->formError('errUsrNotFnd'); 59 | } 60 | 61 | # If there's no error, finish action 62 | if (!@{$m->{formErrors}}) { 63 | # Change ownership of posts 64 | $m->dbDo(" 65 | UPDATE posts SET userId = ?, userNameBak = ? WHERE userId = ?", 66 | $newUserId, $userName, $oldUserId); 67 | 68 | # Change ownership of messages 69 | $m->dbDo(" 70 | UPDATE messages SET senderId = ? WHERE senderId = ?", $newUserId, $oldUserId); 71 | $m->dbDo(" 72 | UPDATE messages SET receiverId = ? WHERE receiverId = ?", $newUserId, $oldUserId); 73 | 74 | # Log action and finish 75 | $m->logAction(1, 'user', 'migrate', $userId, 0, 0, 0, $newUserId); 76 | $m->redirect('user_info', uid => $oldUserId); 77 | } 78 | } 79 | 80 | 81 | # Print form 82 | if (!$submitted || @{$m->{formErrors}}) { 83 | # Print header 84 | $m->printHeader(); 85 | 86 | # Check if user exists 87 | my $oldUserName = $m->fetchArray(" 88 | SELECT userName FROM users WHERE id = ?", $oldUserId); 89 | $oldUserName or $m->error('errUsrNotFnd'); 90 | 91 | # Print page bar 92 | my @navLinks = ({ url => $m->url('user_info', uid => $oldUserId), txt => 'comUp', ico => 'up' }); 93 | $m->printPageBar(mainTitle => "User", subTitle => $oldUserName, navLinks => \@navLinks); 94 | 95 | # Print hints and form errors 96 | $m->printHints(["Changes ownership of ${oldUserName}'s posts and messages to the specified user."]); 97 | $m->printFormErrors(); 98 | 99 | # Print target user form 100 | print 101 | "
\n", 102 | "
\n", 103 | "
Migrate User
\n", 104 | "
\n", 105 | "\n", 107 | $m->submitButton("Migrate", 'merge'), 108 | "\n", 109 | $m->stdFormFields(), 110 | "
\n", 111 | "
\n", 112 | "
\n\n"; 113 | 114 | # Log action and finish 115 | $m->logAction(3, 'user', 'migrate', $userId, 0, 0, 0, $oldUserId); 116 | $m->printFooter(); 117 | } 118 | $m->finish(); 119 | -------------------------------------------------------------------------------- /util/util_cleancfg.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | #------------------------------------------------------------------------------ 3 | # mwForum - Web-based discussion forum 4 | # Copyright (c) 1999-2015 Markus Wichitill 5 | # 6 | # This program is free software; you can redistribute it and/or modify 7 | # it under the terms of the GNU General Public License as published by 8 | # the Free Software Foundation; either version 3 of the License, or 9 | # (at your option) any later version. 10 | # 11 | # This program is distributed in the hope that it will be useful, 12 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | # GNU General Public License for more details. 15 | #------------------------------------------------------------------------------ 16 | 17 | # Remove obsolete and default configuration entries from the config table. 18 | 19 | use strict; 20 | use warnings; 21 | no warnings qw(uninitialized once); 22 | 23 | # Imports 24 | use Getopt::Std (); 25 | require MwfMain; 26 | 27 | # Get arguments 28 | my %opts = (); 29 | Getopt::Std::getopts('?hxf:', \%opts); 30 | my $help = $opts{'?'} || $opts{h}; 31 | my $execute = $opts{x}; 32 | my $forumId = $opts{f}; 33 | usage() if $help; 34 | 35 | # Init 36 | my ($m, $cfg, $lng) = MwfMain->newShell(forumId => $forumId); 37 | $m->dbBegin(); 38 | 39 | # Dry run? 40 | print "\n-x not specified, performing dry run.\n\n" if !$execute; 41 | 42 | # Get default options 43 | my %defOptions; 44 | for my $opt (@$MwfDefaults::options) { 45 | $defOptions{$opt->{name}} = $opt->{default} if $opt->{name}; 46 | } 47 | if (eval { $MwfDefaultsLocal::options }) { 48 | for my $opt (@$MwfDefaultsLocal::options) { 49 | $defOptions{$opt->{name}} = $opt->{default} if $opt->{name}; 50 | } 51 | } 52 | 53 | # Get database options 54 | my %dbOptions; 55 | my $dbOptions = $m->fetchAllHash(" 56 | SELECT name, value, parse FROM config"); 57 | for my $opt (@$dbOptions) { 58 | $dbOptions{$opt->{name}} = $opt->{value} if $opt->{name}; 59 | } 60 | 61 | for my $name (sort keys %dbOptions) { 62 | next if $name eq 'lastUpdate'; 63 | 64 | # Delete obsolete/experimental options that are not in MwfDefaults.pm 65 | if (!exists $defOptions{$name}) { 66 | print "Deleting $name (not in defaults)\n"; 67 | $m->dbDo(" 68 | DELETE FROM config WHERE name = ?", $name) 69 | if $opts{x}; 70 | next; 71 | } 72 | 73 | # Delete option if equal to default value 74 | if (deep_eq($cfg->{$name}, $defOptions{$name})) { 75 | print "Deleting $name (same as default)\n"; 76 | $m->dbDo(" 77 | DELETE FROM config WHERE name = ?", $name) 78 | if $opts{x}; 79 | } 80 | } 81 | 82 | $m->dbCommit(); 83 | 84 | #------------------------------------------------------------------------------ 85 | 86 | # deep_eq() from http://www.perlmonks.org/index.pl?node_id=121559 87 | sub deep_eq { 88 | my ($a, $b) = @_; 89 | if (not defined $a) { return not defined $b } 90 | elsif (not defined $b) { return 0 } 91 | elsif (not ref $a) { $a eq $b } 92 | elsif ($a eq $b) { return 1 } 93 | elsif (ref $a ne ref $b) { return 0 } 94 | elsif (ref $a eq 'SCALAR') { $$a eq $$b } 95 | elsif (ref $a eq 'ARRAY') { 96 | if (@$a == @$b) { 97 | for (0 .. $#$a) { 98 | my $rval; 99 | return $rval unless ($rval = deep_eq($a->[$_], $b->[$_])); 100 | } 101 | return 1; 102 | } 103 | else { return 0 } 104 | } 105 | elsif (ref $a eq 'HASH') { 106 | if (keys %$a == keys %$b) { 107 | for (keys %$a) { 108 | my $rval; 109 | return $rval unless ($rval = deep_eq($a->{$_}, $b->{$_})); 110 | } 111 | return 1; 112 | } 113 | else { return 0 } 114 | } 115 | elsif (ref $a eq ref $b) { warn 'Cannot test '.(ref $a)."\n"; undef } 116 | else { return 0 } 117 | } 118 | 119 | #------------------------------------------------------------------------------ 120 | 121 | sub usage 122 | { 123 | print 124 | "\nRemove obsolete and default configuration entries from the config table.\n\n", 125 | "Usage: util_cleancfg.pl [-x] [-f forum]\n", 126 | " -x Execute cleanup. Otherwise only a dry run is performed.\n", 127 | " -f Forum hostname or URL path when using a multi-forum installation.\n", 128 | ; 129 | 130 | exit 1; 131 | } 132 | -------------------------------------------------------------------------------- /script/user_set.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | #------------------------------------------------------------------------------ 3 | # mwForum - Web-based discussion forum 4 | # Copyright (c) 1999-2015 Markus Wichitill 5 | # 6 | # This program is free software; you can redistribute it and/or modify 7 | # it under the terms of the GNU General Public License as published by 8 | # the Free Software Foundation; either version 3 of the License, or 9 | # (at your option) any later version. 10 | # 11 | # This program is distributed in the hope that it will be useful, 12 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | # GNU General Public License for more details. 15 | #------------------------------------------------------------------------------ 16 | 17 | use strict; 18 | use warnings; 19 | no warnings qw(uninitialized redefine); 20 | 21 | # Imports 22 | use MwfMain; 23 | 24 | #------------------------------------------------------------------------------ 25 | 26 | # Init 27 | my ($m, $cfg, $lng, $user, $userId) = MwfMain->new($_[0]); 28 | 29 | # Check if user is admin 30 | $user->{admin} or $m->error('errNoAccess'); 31 | 32 | # Get CGI parameters 33 | my $optUserId = $m->paramInt('uid'); 34 | my $field = $m->paramStrId('field'); 35 | my $value = $m->paramStr('value'); 36 | my $submitted = $m->paramBool('subm'); 37 | 38 | # Define names and descriptions of fields 39 | my %fields = ( 40 | title => "Title", 41 | dontEmail => "Disable Email", 42 | notify => "Reply Notifications", 43 | msgNotify => "Email Notifications", 44 | tempLogin => "Temporary Login", 45 | privacy => "Privacy", 46 | signature => "Signature", 47 | blurb => "Miscellaneous", 48 | extra1 => "Custom 1", 49 | extra2 => "Custom 2", 50 | extra3 => "Custom 3", 51 | timezone => "Timezone", 52 | language => "Language", 53 | style => "Style", 54 | fontFace => "Font Face", 55 | fontSize => "Font Size", 56 | boardDescs => "Show Board Desc.", 57 | showDeco => "Show Decorations", 58 | showAvatars => "Show Avatars", 59 | showImages => "Show Embed. Imgs", 60 | showSigs => "Show Signatures", 61 | collapse => "Collapse Branches", 62 | indent => "Threading Indent", 63 | topicsPP => "Topics Per Page", 64 | postsPP => "Posts Per Page", 65 | bounceNum => "Bounce Counter", 66 | renamesLeft => "Renames Left", 67 | oldNames => "Old Usernames", 68 | gpgKeyId => "PGP Key ID", 69 | ); 70 | 71 | # Process form 72 | if ($submitted) { 73 | # Check request source authentication 74 | $m->checkSourceAuth() or $m->formError('errSrcAuth'); 75 | 76 | # Make sure valid field is selected 77 | $fields{$field} or $m->formError("Invalid field"); 78 | 79 | # If there's no error, finish action 80 | if (!@{$m->{formErrors}}) { 81 | # Update users 82 | $m->dbDo(" 83 | UPDATE users SET $field = ?", $value); 84 | 85 | # Log action and finish 86 | $m->logAction(1, 'user', 'set', $userId); 87 | $m->redirect('user_set'); 88 | } 89 | } 90 | 91 | # Print form 92 | if (!$submitted || @{$m->{formErrors}}) { 93 | # Print header 94 | $m->printHeader(); 95 | 96 | # Print page bar 97 | my @navLinks = ({ url => $m->url('user_admin'), txt => 'comUp', ico => 'up' }); 98 | $m->printPageBar(mainTitle => "User Administration", navLinks => \@navLinks); 99 | 100 | # Print hints and form errors 101 | $m->printHints(["This form sets the selected user field of all users to the same value. " . 102 | " Use carefully."]); 103 | $m->printFormErrors(); 104 | 105 | # Print mass setting form 106 | print 107 | "
\n", 108 | "
\n", 109 | "
Mass-Setting User Fields
\n", 110 | "
\n", 111 | "\n", 116 | "\n", 118 | $m->submitButton("Mass Set", 'edit'), 119 | $m->stdFormFields(), 120 | "
\n", 121 | "
\n\n", 122 | "
\n\n"; 123 | 124 | # Log action and finish 125 | $m->logAction(3, 'user', 'set', $userId); 126 | $m->printFooter(); 127 | } 128 | $m->finish(); 129 | -------------------------------------------------------------------------------- /script/forum_activity.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | #------------------------------------------------------------------------------ 3 | # mwForum - Web-based discussion forum 4 | # Copyright (c) 1999-2015 Markus Wichitill 5 | # 6 | # This program is free software; you can redistribute it and/or modify 7 | # it under the terms of the GNU General Public License as published by 8 | # the Free Software Foundation; either version 3 of the License, or 9 | # (at your option) any later version. 10 | # 11 | # This program is distributed in the hope that it will be useful, 12 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | # GNU General Public License for more details. 15 | #------------------------------------------------------------------------------ 16 | 17 | use strict; 18 | use warnings; 19 | no warnings qw(uninitialized redefine); 20 | 21 | # Imports 22 | use MwfMain; 23 | 24 | #------------------------------------------------------------------------------ 25 | 26 | # Init 27 | my ($m, $cfg, $lng, $user, $userId) = MwfMain->new($_[0]); 28 | 29 | # Check if access should be denied 30 | $cfg->{statForumActiv} || $user->{admin} or $m->error('errNoAccess'); 31 | !$m->{sqlite} or $m->error('errNoAccess'); 32 | 33 | # Get statistics 34 | my $query = ""; 35 | my $yearStats = undef; 36 | if ($m->{mysql}) { 37 | $m->dbDo(" 38 | CREATE TEMPORARY TABLE times AS 39 | SELECT FROM_UNIXTIME(postTime) AS ts FROM posts 40 | UNION ALL 41 | SELECT FROM_UNIXTIME(postTime) AS ts FROM arc_posts"); 42 | $m->dbDo(" 43 | CREATE TEMPORARY TABLE postsPerDay AS 44 | SELECT YEAR(ts) AS year, DAYOFYEAR(ts) - 1 AS doy, COUNT(*) AS num 45 | FROM times 46 | GROUP BY year, doy"); 47 | $yearStats = $m->fetchAllArray(" 48 | SELECT YEAR(ts) AS year, COUNT(*) AS num 49 | FROM times 50 | GROUP BY year 51 | ORDER BY year"); 52 | } 53 | elsif ($m->{pgsql}) { 54 | $m->dbDo(" 55 | CREATE TEMPORARY TABLE times AS 56 | SELECT TIMESTAMP 'epoch' + INTERVAL '1 second' * postTime AS ts FROM posts 57 | UNION ALL 58 | SELECT TIMESTAMP 'epoch' + INTERVAL '1 second' * postTime AS ts FROM arc_posts"); 59 | $m->dbDo(" 60 | CREATE TEMPORARY TABLE postsPerDay AS 61 | SELECT EXTRACT(YEAR FROM ts) AS year, EXTRACT(DOY FROM ts) - 1 AS doy, COUNT(*) AS num 62 | FROM times 63 | GROUP BY year, doy"); 64 | $yearStats = $m->fetchAllArray(" 65 | SELECT EXTRACT(YEAR FROM ts) AS year, COUNT(*) AS num 66 | FROM times 67 | GROUP BY year 68 | ORDER BY year"); 69 | } 70 | my $ppdStats = $m->fetchAllArray(" 71 | SELECT * FROM postsPerDay"); 72 | my $ppdMaxPerDay = $m->fetchArray(" 73 | SELECT MAX(num) FROM postsPerDay"); 74 | my $firstYear = $m->fetchArray(" 75 | SELECT MIN(year) FROM postsPerDay"); 76 | my $lastYear = $m->fetchArray(" 77 | SELECT MAX(year) FROM postsPerDay"); 78 | 79 | # Print header 80 | $m->printHeader(undef, { firstYear => $firstYear, lastYear => $lastYear }); 81 | 82 | # Print page bar 83 | my @userLinks = (); 84 | my @navLinks = ({ url => $m->url('forum_info'), txt => 'comUp', ico => 'up' }); 85 | $m->printPageBar(mainTitle => $lng->{actTitle}, navLinks => \@navLinks, userLinks => \@userLinks); 86 | 87 | # Print hint 88 | $m->printHints([$lng->{actPstDayT}]); 89 | 90 | # Print posts-per-day data, canvas and script 91 | my $ppdJson = "{" . join(",", map("\"$_->[0].$_->[1]\":$_->[2]", @$ppdStats)) . "}"; 92 | my $ppdWidth = ($lastYear - $firstYear + 1) * 365; 93 | my $ppdHeight = $m->min($m->max($ppdMaxPerDay, 30), 300); 94 | print 95 | "\n\n", 96 | "
\n", 97 | "
$lng->{actPstDayTtl}
\n", 98 | "
\n", 99 | "$lng->{errUAFeatSup}\n", 100 | "
\n", 101 | "
\n\n"; 102 | 103 | # Print table 104 | print 105 | "\n", 106 | "\n", 107 | map("\n", @$yearStats), 108 | "
$lng->{actPstYrTtl}
$_->[0]$_->[1]
\n\n"; 109 | 110 | # Drop temp tables 111 | $m->dbDo("DROP TABLE times"); 112 | $m->dbDo("DROP TABLE postsPerDay"); 113 | 114 | # Log action and finish 115 | $m->logAction(3, 'forum', 'activity', $userId); 116 | $m->printFooter(); 117 | $m->finish(); 118 | -------------------------------------------------------------------------------- /script/user_name.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | #------------------------------------------------------------------------------ 3 | # mwForum - Web-based discussion forum 4 | # Copyright (c) 1999-2015 Markus Wichitill 5 | # 6 | # This program is free software; you can redistribute it and/or modify 7 | # it under the terms of the GNU General Public License as published by 8 | # the Free Software Foundation; either version 3 of the License, or 9 | # (at your option) any later version. 10 | # 11 | # This program is distributed in the hope that it will be useful, 12 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | # GNU General Public License for more details. 15 | #------------------------------------------------------------------------------ 16 | 17 | use strict; 18 | use warnings; 19 | no warnings qw(uninitialized redefine); 20 | 21 | # Imports 22 | use MwfMain; 23 | 24 | #------------------------------------------------------------------------------ 25 | 26 | # Init 27 | my ($m, $cfg, $lng, $user, $userId) = MwfMain->new($_[0]); 28 | 29 | # Check if access should be denied 30 | $userId or $m->error('errNoAccess'); 31 | $user->{renamesLeft} or $m->error('errNoAccess'); 32 | 33 | # Get CGI parameters 34 | my $userName = $m->paramStr('name') || ""; 35 | my $submitted = $m->paramBool('subm'); 36 | 37 | # Process form 38 | if ($submitted) { 39 | # Check request source authentication 40 | $m->checkSourceAuth() or $m->formError('errSrcAuth'); 41 | 42 | # Check username for validity 43 | length($userName) or $m->formError('errNamEmpty'); 44 | if (length($userName)) { 45 | length($userName) >= 2 && length($userName) <= $cfg->{maxUserNameLen} 46 | or $m->formError('errNamSize'); 47 | $userName =~ /$cfg->{userNameRegExp}/ or $m->formError('errNamChar'); 48 | $userName !~ / / or $m->formError('errNamChar'); 49 | $userName !~ /https?:/ or $m->formError('errNamResrvd'); 50 | index(lc($userName), lc($_)) < 0 or $m->formError('errNamResrvd') 51 | for @{$cfg->{reservedNames}}; 52 | } 53 | 54 | # Check if username is free 55 | !$m->fetchArray(" 56 | SELECT id FROM users WHERE userName = ?", $userName) 57 | or $m->formError('errNamGone'); 58 | 59 | # Track old usernames 60 | my $oldNames = length($user->{userName}) > 20 && $user->{openId} =~ /$user->{userName}/ 61 | ? "" : join(", ", $user->{userName}, $user->{oldNames} || ()); 62 | 63 | # If there's no error, finish action 64 | if (!@{$m->{formErrors}}) { 65 | # Update user 66 | $m->dbDo(" 67 | UPDATE users SET userName = ?, oldNames = ?, renamesLeft = renamesLeft - 1 WHERE id = ?", 68 | $userName, $oldNames, $userId); 69 | 70 | # Update posts.userNameBak 71 | $m->dbDo(" 72 | UPDATE posts SET userNameBak = ? WHERE userId = ?", $userName, $userId); 73 | 74 | # Log action and finish 75 | $m->logAction(1, 'user', 'name', $userId); 76 | $m->redirect('user_profile', msg => 'NamChange'); 77 | } 78 | } 79 | 80 | # Print form 81 | if (!$submitted || @{$m->{formErrors}}) { 82 | # Print header 83 | $m->printHeader(); 84 | 85 | # Print page bar 86 | my @navLinks = ({ url => $m->url('user_profile', uid => $userId), 87 | txt => 'comUp', ico => 'up' }); 88 | $m->printPageBar(mainTitle => $lng->{namTitle}, subTitle => $user->{userName}, 89 | navLinks => \@navLinks); 90 | 91 | # Print hints and form errors 92 | $m->printHints(['namChgT']); 93 | $m->printFormErrors(); 94 | 95 | # Prepare values 96 | my $userNameEsc = $submitted ? $m->escHtml($userName) : $user->{userName}; 97 | 98 | # Print profile options 99 | print 100 | "
\n", 101 | "
\n", 102 | "
$lng->{namChgTtl}
\n", 103 | "
\n", 104 | "

", $m->formatStr($lng->{namChgT2}, { times => $user->{renamesLeft} }), "

\n", 105 | "\n", 108 | $m->submitButton('namChgB', 'name'), 109 | $m->stdFormFields(), 110 | "
\n", 111 | "
\n\n", 112 | "
\n\n"; 113 | 114 | # Log action and finish 115 | $m->logAction(3, 'user', 'name', $userId, 0, 0, 0, $userId); 116 | $m->printFooter(); 117 | } 118 | $m->finish(); 119 | -------------------------------------------------------------------------------- /script/user_countries.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | #------------------------------------------------------------------------------ 3 | # mwForum - Web-based discussion forum 4 | # Copyright (c) 1999-2015 Markus Wichitill 5 | # 6 | # This program is free software; you can redistribute it and/or modify 7 | # it under the terms of the GNU General Public License as published by 8 | # the Free Software Foundation; either version 3 of the License, or 9 | # (at your option) any later version. 10 | # 11 | # This program is distributed in the hope that it will be useful, 12 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | # GNU General Public License for more details. 15 | #------------------------------------------------------------------------------ 16 | 17 | use strict; 18 | use warnings; 19 | no warnings qw(uninitialized redefine); 20 | 21 | # Imports 22 | use MwfMain; 23 | 24 | #------------------------------------------------------------------------------ 25 | 26 | # Init 27 | my ($m, $cfg, $lng, $user, $userId) = MwfMain->new($_[0]); 28 | 29 | # Check if access should be denied 30 | $cfg->{statUserCntry} || $user->{admin} or $m->error('errNoAccess'); 31 | 32 | # Get CGI parameters 33 | my $days = $m->paramInt('days') || 365; 34 | 35 | # Print header 36 | $m->printHeader(); 37 | 38 | # Print page bar 39 | my @userLinks = (); 40 | push @userLinks, { url => $m->url('user_countries', days => 7), txt => 7 }; 41 | push @userLinks, { url => $m->url('user_countries', days => 30), txt => 30 }; 42 | push @userLinks, { url => $m->url('user_countries', days => 90), txt => 90 }; 43 | push @userLinks, { url => $m->url('user_countries', days => 365), txt => 365 }; 44 | my @navLinks = ({ url => $m->url('forum_info'), txt => 'comUp', ico => 'up' }); 45 | $m->printPageBar(mainTitle => $lng->{ucoTitle}, navLinks => \@navLinks, userLinks => \@userLinks); 46 | 47 | # Create GeoIP object 48 | my $geoIp = undef; 49 | if (eval { require Geo::IP }) { 50 | $geoIp = Geo::IP->open($cfg->{geoIp}, 51 | defined($cfg->{geoIpCacheMode}) ? $cfg->{geoIpCacheMode} : 1); 52 | } 53 | elsif (eval { require Geo::IP::PurePerl }) { 54 | $geoIp = Geo::IP::PurePerl->open($cfg->{geoIp}); 55 | } 56 | else { 57 | $m->error("Geo::IP or Geo::IP::PurePerl modules not available."); 58 | } 59 | $geoIp or $m->error("Opening GeoIP file failed."); 60 | 61 | # Get country stats 62 | my $sth = $m->fetchSth(" 63 | SELECT lastIp FROM users WHERE lastIp <> '' AND lastOnTime > ? - ? * 86400", 64 | $m->{now}, $days); 65 | my $ip; 66 | $sth->bind_col(1, \$ip); 67 | my %countries = (); 68 | my $users = 0; 69 | my $city = index($cfg->{geoIp}, 'City') > -1 ? 1 : 0; 70 | while ($sth->fetch()) { 71 | $users++; 72 | my ($code, $name); 73 | if ($city) { 74 | if (my $rec = $geoIp->record_by_addr($ip)) { 75 | $code = $rec->country_code(); 76 | $name = $rec->country_name(); 77 | } 78 | } 79 | else { 80 | $code = $geoIp->country_code_by_addr($ip); 81 | $name = $geoIp->country_name_by_addr($ip); 82 | } 83 | next if $code !~ /^[A-Z]{2}\z/; 84 | if ($countries{$code}) { $countries{$code}[1]++ } 85 | else { $countries{$code} = [ $name, 1 ] } 86 | } 87 | my @codes = sort keys %countries; 88 | my $json = "[" . join(",", map("[\"$_\",$countries{$_}[1]]", @codes)) . "]"; 89 | 90 | # Print hint 91 | $m->printHints([$m->formatStr($lng->{uasUsersT}, { users => $users, days => $days })]); 92 | 93 | # Print map 94 | print 95 | "
\n", 96 | "
$lng->{ucoMapTtl}
\n", 97 | "
\n", 98 | "
\n", 99 | "\n", 101 | "\n", 102 | "
\n", 103 | "
\n", 104 | "
\n\n"; 105 | 106 | # Print table 107 | print 108 | "\n", 109 | "\n"; 110 | for my $code (sort { $countries{$b}[1] <=> $countries{$a}[1] } @codes) { 111 | print 112 | "\n"; 114 | } 115 | print "
$lng->{ucoCntryTtl}
", 113 | "$countries{$code}[0]$countries{$code}[1]
\n\n"; 116 | 117 | # Log action and finish 118 | $m->logAction(3, 'user', 'country', $userId); 119 | $m->printFooter(); 120 | $m->finish(); 121 | -------------------------------------------------------------------------------- /script/user_password.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | #------------------------------------------------------------------------------ 3 | # mwForum - Web-based discussion forum 4 | # Copyright (c) 1999-2015 Markus Wichitill 5 | # 6 | # This program is free software; you can redistribute it and/or modify 7 | # it under the terms of the GNU General Public License as published by 8 | # the Free Software Foundation; either version 3 of the License, or 9 | # (at your option) any later version. 10 | # 11 | # This program is distributed in the hope that it will be useful, 12 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | # GNU General Public License for more details. 15 | #------------------------------------------------------------------------------ 16 | 17 | use strict; 18 | use warnings; 19 | no warnings qw(uninitialized redefine); 20 | 21 | # Imports 22 | use MwfMain; 23 | 24 | #------------------------------------------------------------------------------ 25 | 26 | # Init 27 | my ($m, $cfg, $lng, $user, $userId) = MwfMain->new($_[0]); 28 | 29 | # Check if access should be denied 30 | $userId or $m->error('errNoAccess'); 31 | 32 | # Don't change password when auth plugin is used 33 | !$cfg->{authenPlg}{login} && !$cfg->{authenPlg}{request} 34 | or $m->error("Password change n/a when auth plugin is used."); 35 | 36 | # Get CGI parameters 37 | my $optUserId = $m->paramInt('uid'); 38 | my $password = $m->paramStr('password') || ""; 39 | my $passwordV = $m->paramStr('passwordV') || ""; 40 | my $submitted = $m->paramBool('subm'); 41 | 42 | # Select which user to edit 43 | my $optUser = $optUserId && $user->{admin} ? $m->getUser($optUserId) : $user; 44 | $optUser or $m->error('errUsrNotFnd'); 45 | $optUserId = $optUser->{id}; 46 | 47 | # Process form 48 | if ($submitted) { 49 | # Check request source authentication 50 | $m->checkSourceAuth() or $m->formError('errSrcAuth'); 51 | 52 | # Check password for validity 53 | $password eq $passwordV or $m->formError('errPwdDiffer'); 54 | length($password) >= 8 or $m->formError('errPwdSize'); 55 | 56 | # Get new salt, loginAuth and password hash 57 | my $salt = $m->randomId(); 58 | my $loginAuth = $m->randomId(); 59 | my $passwordHash = $m->hashPassword($password, $salt); 60 | 61 | # If there's no error, finish action 62 | if (!@{$m->{formErrors}}) { 63 | # Update user 64 | $m->dbDo(" 65 | UPDATE users SET password = ?, salt = ?, loginAuth = ? WHERE id = ?", 66 | $passwordHash, $salt, $loginAuth, $optUserId); 67 | 68 | # Update cookies if password changed 69 | $m->setCookie('login', "$optUserId:$loginAuth", $optUser->{tempLogin}) 70 | if $optUserId == $userId; 71 | 72 | # Log action and finish 73 | $m->logAction(1, 'user', 'passwd', $userId, 0, 0, 0, $optUserId); 74 | $m->redirect('user_options', uid => $optUserId, msg => 'PwdChange'); 75 | } 76 | } 77 | 78 | # Print form 79 | if (!$submitted || @{$m->{formErrors}}) { 80 | # Print header 81 | $m->printHeader(); 82 | 83 | # Print page bar 84 | my @navLinks = ({ url => $m->url('user_options', uid => $optUserId), 85 | txt => 'comUp', ico => 'up' }); 86 | $m->printPageBar(mainTitle => $lng->{pwdTitle}, subTitle => $optUser->{userName}, 87 | navLinks => \@navLinks); 88 | 89 | # Print hints and form errors 90 | $m->printHints(['pwdChgT']); 91 | $m->printFormErrors(); 92 | 93 | # Print password form 94 | print 95 | "
\n", 96 | "
\n", 97 | "
$lng->{pwdChgTtl}
\n", 98 | "
\n", 99 | "\n", 102 | "\n", 106 | $m->submitButton('pwdChgB', 'password'), 107 | "\n", 108 | $m->stdFormFields(), 109 | "
\n", 110 | "
\n", 111 | "
\n\n"; 112 | 113 | # Log action and finish 114 | $m->logAction(3, 'user', 'passwd', $userId, 0, 0, 0, $optUserId); 115 | $m->printFooter(); 116 | } 117 | $m->finish(); 118 | -------------------------------------------------------------------------------- /script/categ_options.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | #------------------------------------------------------------------------------ 3 | # mwForum - Web-based discussion forum 4 | # Copyright (c) 1999-2015 Markus Wichitill 5 | # 6 | # This program is free software; you can redistribute it and/or modify 7 | # it under the terms of the GNU General Public License as published by 8 | # the Free Software Foundation; either version 3 of the License, or 9 | # (at your option) any later version. 10 | # 11 | # This program is distributed in the hope that it will be useful, 12 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | # GNU General Public License for more details. 15 | #------------------------------------------------------------------------------ 16 | 17 | use strict; 18 | use warnings; 19 | no warnings qw(uninitialized redefine); 20 | 21 | # Imports 22 | use MwfMain; 23 | 24 | #------------------------------------------------------------------------------ 25 | 26 | # Init 27 | my ($m, $cfg, $lng, $user, $userId) = MwfMain->new($_[0]); 28 | 29 | # Check if user is admin 30 | $user->{admin} or $m->error('errNoAccess'); 31 | 32 | # Get CGI parameters 33 | my $categId = $m->paramInt('cid'); 34 | my $title = $m->paramStr('title'); 35 | my $pos = $m->paramInt('pos'); 36 | my $submitted = $m->paramBool('subm'); 37 | $categId or $m->error('errParamMiss'); 38 | 39 | # Process form 40 | if ($submitted) { 41 | # Check request source authentication 42 | $m->checkSourceAuth() or $m->formError('errSrcAuth'); 43 | 44 | # Get category 45 | my $oldPos = $m->fetchArray(" 46 | SELECT pos FROM categories WHERE id = ?", $categId); 47 | $oldPos or $m->error('errCatNotFnd'); 48 | 49 | # Check fields 50 | $title or $m->formError("Title is empty."); 51 | 52 | # If there's no error, finish action 53 | if (!@{$m->{formErrors}}) { 54 | # Update category 55 | my $titleEsc = $m->escHtml($title); 56 | $m->dbDo(" 57 | UPDATE categories SET title = ? WHERE id = ?", $titleEsc, $categId); 58 | 59 | # Update positions 60 | if ($pos > -1) { 61 | $pos = $pos - 1 if $pos > $oldPos; 62 | $m->dbDo(" 63 | UPDATE categories SET pos = pos - 1 WHERE pos > ?", $oldPos); 64 | $m->dbDo(" 65 | UPDATE categories SET pos = pos + 1 WHERE pos > ?", $pos); 66 | $m->dbDo(" 67 | UPDATE categories SET pos = ? + 1 WHERE id = ?", $pos, $categId); 68 | } 69 | 70 | # Log action and finish 71 | $m->logAction(1, 'categ', 'options', $userId, 0, 0, 0, $categId); 72 | $m->redirect('categ_admin'); 73 | } 74 | } 75 | 76 | # Print form 77 | if (!$submitted || @{$m->{formErrors}}) { 78 | # Print header 79 | $m->printHeader(); 80 | 81 | # Get category 82 | my $categ = $m->fetchHash(" 83 | SELECT title, pos FROM categories WHERE id = ?", $categId); 84 | $categ or $m->error('errCatNotFnd'); 85 | 86 | # Get other categories 87 | my $categs = $m->fetchAllHash(" 88 | SELECT title, pos FROM categories WHERE id <> ? ORDER BY pos", $categId); 89 | 90 | # Print page bar 91 | my @navLinks = ({ url => $m->url('categ_admin'), txt => 'comUp', ico => 'up' }); 92 | $m->printPageBar(mainTitle => "Category", subTitle => $categ->{title}, navLinks => \@navLinks); 93 | 94 | # Print hints and form errors 95 | $m->printFormErrors(); 96 | 97 | # Prepare values 98 | my $titleEsc = $submitted ? $m->escHtml($title) : $categ->{title}; 99 | 100 | # Print options form 101 | print 102 | "
\n", 103 | "
\n", 104 | "
Options
\n", 105 | "
\n", 106 | "\n", 109 | "\n", 115 | $m->submitButton("Change", 'admopt'), 116 | "\n", 117 | $m->stdFormFields(), 118 | "
\n", 119 | "
\n", 120 | "
\n\n"; 121 | 122 | # Log action and finish 123 | $m->logAction(3, 'categ', 'options', $userId, 0, 0, 0, $categId); 124 | $m->printFooter(); 125 | } 126 | $m->finish(); 127 | -------------------------------------------------------------------------------- /example/MwfPlgEvent.pm: -------------------------------------------------------------------------------- 1 | #------------------------------------------------------------------------------ 2 | # mwForum - Web-based discussion forum 3 | # Copyright © 1999-2015 Markus Wichitill 4 | # 5 | # This program is free software; you can redistribute it and/or modify 6 | # it under the terms of the GNU General Public License as published by 7 | # the Free Software Foundation; either version 3 of the License, or 8 | # (at your option) any later version. 9 | # 10 | # This program is distributed in the hope that it will be useful, 11 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | # GNU General Public License for more details. 14 | #------------------------------------------------------------------------------ 15 | 16 | package MwfPlgEvent; 17 | use utf8; 18 | use strict; 19 | use warnings; 20 | no warnings qw(uninitialized redefine); 21 | our $VERSION = "2.27.0"; 22 | 23 | #------------------------------------------------------------------------------ 24 | # Hide a specific board for newly registered users 25 | 26 | sub userRegisterHideBoard 27 | { 28 | my %params = @_; 29 | my $m = $params{m}; 30 | my $level = $params{level}; 31 | my $entity = $params{entity}; 32 | my $action = $params{action}; 33 | my $userId = $params{userId}; 34 | 35 | if ($level == 1 && $entity eq 'user' && $action eq 'register') { 36 | $m->dbDo(" 37 | INSERT INTO boardHiddenFlags (userId, boardId) VALUES (?, ?)", $userId, 9); 38 | } 39 | } 40 | 41 | #------------------------------------------------------------------------------ 42 | # Auto-ban newly registered users to emulate a queue from which admins have to 43 | # manually approve users before they can post (e.g. to hinder spambots) 44 | 45 | sub userRegisterQueue 46 | { 47 | my %params = @_; 48 | my $m = $params{m}; 49 | my $level = $params{level}; 50 | my $entity = $params{entity}; 51 | my $action = $params{action}; 52 | my $userId = $params{userId}; 53 | 54 | if ($level == 1 && $entity eq 'user' && $action eq 'register') { 55 | my $reason = "Awaiting manual approval by an admin for spam protection reasons."; 56 | $m->dbDo(" 57 | INSERT INTO userBans (userId, banTime, duration, reason, intReason) 58 | VALUES (?, ?, ?, ?, ?)", 59 | $userId, $m->{now}, 0, $reason, '[queued]'); 60 | 61 | # Add notification message for admin with userId 1 62 | my $link = "user"; 63 | $m->addNote('usrReg', 1, "A $link registered and requires un-banning."); 64 | } 65 | } 66 | 67 | #----------------------------------------------------------------------------- 68 | # Make a backup copy of all new posts 69 | 70 | sub postAddBackup 71 | { 72 | my %params = @_; 73 | my $m = $params{m}; 74 | my $level = $params{level}; 75 | my $entity = $params{entity}; 76 | my $action = $params{action}; 77 | my $postId = $params{postId}; 78 | 79 | if ($level == 1 && ($entity eq 'post' || $entity eq 'topic') && $action eq 'add') { 80 | $m->dbDo(" 81 | INSERT INTO postBackups 82 | SELECT * FROM posts WHERE id = ?", $postId); 83 | } 84 | } 85 | 86 | #----------------------------------------------------------------------------- 87 | # Mark posts by certain users as unapproved in any board 88 | 89 | sub postAddUnapprove 90 | { 91 | my %params = @_; 92 | my $m = $params{m}; 93 | my $level = $params{level}; 94 | my $entity = $params{entity}; 95 | my $action = $params{action}; 96 | my $postId = $params{postId}; 97 | 98 | if ($level == 1 && ($entity eq 'post' || $entity eq 'topic') && $action eq 'add' 99 | && $m->{user}{comment} =~ /\[troll\]/i) { 100 | $m->dbDo(" 101 | UPDATE posts SET approved = 0 WHERE id = ?", $postId); 102 | } 103 | } 104 | 105 | #----------------------------------------------------------------------------- 106 | # Log events to file 107 | 108 | sub logToFile 109 | { 110 | my %params = @_; 111 | my $m = $params{m}; 112 | 113 | open my $fh, ">>:utf8", $m->{cfg}{logFile} or return 0; 114 | flock $fh, 2; 115 | seek $fh, 0, 2; 116 | my $timeStr = $m->formatTime($params{logTime}, 0, "%Y-%m-%d %H:%M:%S"); 117 | print $fh 118 | "[$timeStr] [$m->{env}{userIp}] [$m->{env}{script}]", 119 | " $params{level} $params{entity} $params{action} $params{userId} $params{boardId}", 120 | " $params{topicId} $params{postId} $params{extraId} $params{string}\n"; 121 | close $fh; 122 | return 1; 123 | } 124 | 125 | #----------------------------------------------------------------------------- 126 | 1; 127 | -------------------------------------------------------------------------------- /script/cron_bounce.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | #------------------------------------------------------------------------------ 3 | # mwForum - Web-based discussion forum 4 | # Copyright (c) 1999-2015 Markus Wichitill 5 | # 6 | # This program is free software; you can redistribute it and/or modify 7 | # it under the terms of the GNU General Public License as published by 8 | # the Free Software Foundation; either version 3 of the License, or 9 | # (at your option) any later version. 10 | # 11 | # This program is distributed in the hope that it will be useful, 12 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | # GNU General Public License for more details. 15 | #------------------------------------------------------------------------------ 16 | 17 | use strict; 18 | use warnings; 19 | no warnings qw(uninitialized); 20 | 21 | # Imports 22 | use Getopt::Std (); 23 | use Mail::POP3Client (); 24 | use MwfMain; 25 | 26 | #------------------------------------------------------------------------------ 27 | 28 | # Get arguments 29 | my %opts = (); 30 | Getopt::Std::getopts('sf:', \%opts); 31 | my $spawned = $opts{s}; 32 | my $forumId = $opts{f}; 33 | 34 | # Init 35 | my ($m, $cfg, $lng) = MwfMain->newShell(forumId => $forumId, spawned => $spawned); 36 | 37 | # Connect to POP3 account 38 | my $pop = Mail::POP3Client->new( 39 | USER => $cfg->{bouncePopUser}, 40 | PASSWORD => $cfg->{bouncePopPwd}, 41 | HOST => $cfg->{bouncePopHost} || 'localhost', 42 | AUTH_MODE => $cfg->{bouncePopAuth} || 'BEST', 43 | PORT => $cfg->{bouncePopPort} || 110, 44 | TIMEOUT => $cfg->{bouncePopTout} || 20, 45 | USESSL => $cfg->{bouncePopSsl} || 0, 46 | DEBUG => $cfg->{bouncePopDbg} || 0, 47 | ); 48 | $pop->Alive() or $m->error("POP3 connection failed."); 49 | 50 | # Retrieve messages 51 | my @emails = (); 52 | my $emailNum = $pop->Count(); 53 | defined($emailNum) && $emailNum != -1 or $m->error("POP3 connection failed. ($!)"); 54 | for my $i (1 .. $emailNum) { 55 | push @emails, scalar $pop->Body($i); 56 | $pop->Delete($i); 57 | } 58 | 59 | # Close connection 60 | $pop->Close(); 61 | 62 | # For each email 63 | for my $email (@emails) { 64 | # Get auth value from email 65 | my ($auth) = $email =~ /X-mwForum-BounceAuth: ([A-Za-z_0-9-]+)/; 66 | $auth or $m->logAction(3, 'bounce', 'noauth'), next; 67 | 68 | # Get user with auth value 69 | my $caseSensitive = $m->{mysql} ? 'BINARY' : 'TEXT'; 70 | my $authUser = $m->fetchHash(" 71 | SELECT id, bounceNum, dontEmail, regTime, lastOnTime 72 | FROM users 73 | WHERE bounceAuth = CAST(? AS $caseSensitive)", 74 | $auth); 75 | $authUser or $m->logAction(2, 'bounce', 'nouser'), next; 76 | my $authUserId = $authUser->{id}; 77 | $m->logAction(1, 'bounce', 'auth', $authUserId); 78 | 79 | # Delete users that never logged in (registered with invalid email) 80 | if ($authUser->{regTime} == $authUser->{lastOnTime}) { 81 | $m->logAction(1, 'bounce', 'delnew', $authUserId); 82 | $m->deleteUser($authUserId); 83 | next; 84 | } 85 | 86 | # Update user's bounceNum 87 | my $bounceFactor = $cfg->{bounceFactor} || 3; 88 | my $oldBounceNum = $authUser->{bounceNum}; 89 | my $newBounceNum = $oldBounceNum + $bounceFactor; 90 | $m->dbDo(" 91 | UPDATE users SET bounceNum = ? WHERE id = ?", $newBounceNum, $authUserId); 92 | 93 | # Take action depending on configured policy 94 | my $warnTrsh = $cfg->{bounceTrshWarn} * $bounceFactor; 95 | my $cnclTrsh = $cfg->{bounceTrshCncl} * $bounceFactor; 96 | my $dsblTrsh = $cfg->{bounceTrshDsbl} * $bounceFactor; 97 | 98 | if ($warnTrsh && $oldBounceNum < $warnTrsh && $newBounceNum >= $warnTrsh) { 99 | # Add notification if there isn't already one 100 | my $warned = $m->fetchArray(" 101 | SELECT 1 FROM notes WHERE type = ? AND userId = ?", 'bncWrn', $authUserId); 102 | $m->addNote('bncWrn', $authUserId, 'bncWarning') if !$warned; 103 | } 104 | elsif ($cnclTrsh && $oldBounceNum < $cnclTrsh && $newBounceNum >= $cnclTrsh) { 105 | # Cancel subscriptions and clear email notification options 106 | $m->dbDo(" 107 | DELETE FROM boardSubscriptions WHERE userId = ?", $authUserId); 108 | $m->dbDo(" 109 | DELETE FROM topicSubscriptions WHERE userId = ?", $authUserId); 110 | $m->dbDo(" 111 | UPDATE users SET msgNotify = 0 WHERE id = ?", $authUserId); 112 | } 113 | elsif ($dsblTrsh && $oldBounceNum < $dsblTrsh && $newBounceNum >= $dsblTrsh) { 114 | # Set dontEmail flag unless it's already set 115 | $m->dbDo(" 116 | UPDATE users SET dontEmail = 1 WHERE id = ?", $authUserId) 117 | if !$authUser->{dontEmail}; 118 | } 119 | } 120 | -------------------------------------------------------------------------------- /script/report_list.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | #------------------------------------------------------------------------------ 3 | # mwForum - Web-based discussion forum 4 | # Copyright (c) 1999-2015 Markus Wichitill 5 | # 6 | # This program is free software; you can redistribute it and/or modify 7 | # it under the terms of the GNU General Public License as published by 8 | # the Free Software Foundation; either version 3 of the License, or 9 | # (at your option) any later version. 10 | # 11 | # This program is distributed in the hope that it will be useful, 12 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | # GNU General Public License for more details. 15 | #------------------------------------------------------------------------------ 16 | 17 | use strict; 18 | use warnings; 19 | no warnings qw(uninitialized redefine); 20 | 21 | # Imports 22 | use MwfMain; 23 | 24 | #------------------------------------------------------------------------------ 25 | 26 | # Init 27 | my ($m, $cfg, $lng, $user, $userId) = MwfMain->new($_[0]); 28 | 29 | # Check if access should be denied 30 | $cfg->{reports} or $m->error('errNoAccess'); 31 | $userId or $m->error('errNoAccess'); 32 | 33 | # Get CGI parameters 34 | my $boardId = $m->paramInt('bid'); 35 | 36 | # Print header 37 | $m->printHeader(); 38 | 39 | # Print page bar 40 | my @navLinks = ({ url => $m->url('forum_show'), txt => 'comUp', ico => 'up' }); 41 | $m->printPageBar(mainTitle => $lng->{repTitle}, navLinks => \@navLinks); 42 | 43 | # Determine which boards user can and wants to see 44 | my @boardIds = (); 45 | my $boardStr = ""; 46 | if ($user->{admin} && $boardId) { 47 | $boardStr = "WHERE posts.boardId = :boardId"; 48 | } 49 | elsif (!$user->{admin}) { 50 | if ($boardId) { 51 | $m->boardAdmin($userId, $boardId) or $m->error('errNoAccess'); 52 | $boardStr = "WHERE posts.boardId = :boardId"; 53 | } 54 | else { 55 | my $boards = $m->fetchAllArray(" 56 | SELECT id FROM boards"); 57 | @$boards = grep($m->boardAdmin($userId, $_->[0]), @$boards); 58 | @$boards or $m->error('errNoAccess'); 59 | @boardIds = map($_->[0], @$boards); 60 | $boardStr = "WHERE posts.boardId IN (:boardIds)"; 61 | } 62 | } 63 | 64 | # Get reported posts 65 | my $posts = $m->fetchAllHash(" 66 | SELECT postReports.userId AS reporterId, postReports.reason, 67 | posts.id, posts.userId, posts.userNameBak, posts.topicId, posts.postTime, posts.body, 68 | topics.subject, 69 | users.userName, 70 | reporters.id AS reporterId, reporters.userName AS reporterName 71 | FROM postReports AS postReports 72 | INNER JOIN posts AS posts 73 | ON posts.id = postReports.postId 74 | INNER JOIN topics AS topics 75 | ON topics.id = posts.topicId 76 | LEFT JOIN users AS users 77 | ON users.id = posts.userId 78 | LEFT JOIN users AS reporters 79 | ON reporters.id = postReports.userId 80 | $boardStr 81 | ORDER BY posts.postTime DESC", 82 | { boardId => $boardId, boardIds => \@boardIds }); 83 | 84 | # Print reports 85 | for my $post (@$posts) { 86 | # Shortcuts 87 | my $postId = $post->{id}; 88 | 89 | # Format output 90 | my $userNameStr = $post->{userName} || $post->{userNameBak} || " - "; 91 | my $reporterNameStr = $post->{reporterName} || " - "; 92 | my $infUrl = $m->url('user_info', uid => $post->{reporterId}); 93 | $reporterNameStr = "$reporterNameStr"; 94 | my $report = { isReport => 1, body => $post->{reason} }; 95 | $m->dbToDisplay({}, $report); 96 | $m->dbToDisplay({}, $post); 97 | my $shwUrl = $m->url('topic_show', pid => $postId); 98 | 99 | # Print post 100 | print 101 | "
\n", 102 | "
\n", 103 | "
$lng->{repBy} $reporterNameStr
\n", 104 | "
\n", 105 | "$report->{body}\n", 106 | "
\n", 107 | "
\n", 108 | "
$lng->{repTopic}: $post->{subject}
\n", 109 | "
$lng->{repPoster}: $userNameStr
\n", 110 | "
$post->{body}
\n", 111 | $m->submitButton('repDeleteB', 'remove'), 112 | "\n", 113 | "\n", 114 | $m->stdFormFields(), 115 | "
\n", 116 | "
\n", 117 | "
\n\n"; 118 | } 119 | 120 | # If list is empty, display notification 121 | print "
$lng->{repEmpty}
\n\n" if !@$posts; 122 | 123 | # Log action and finish 124 | $m->logAction(2, 'report', 'list', $userId); 125 | $m->printFooter(); 126 | $m->finish(); 127 | --------------------------------------------------------------------------------