Compare commits

..

115 Commits

Author SHA1 Message Date
cltbld
931d8eedab "Automated configuration bump, release for firefox 3.0.19build1"
git-svn-id: svn://10.0.0.236/branches/release@259954 18797224-902f-48f8-a5cc-f745e15eee43
2010-03-13 02:02:11 +00:00
cltbld
2a1a9ff2df "Automated configuration bump, release for firefox 3.0.18build1"
git-svn-id: svn://10.0.0.236/branches/release@259581 18797224-902f-48f8-a5cc-f745e15eee43
2010-02-03 03:05:03 +00:00
cltbld
0543390bce "Automated configuration bump, release for xulrunner 1.9.0.17build1"
git-svn-id: svn://10.0.0.236/branches/release@259282 18797224-902f-48f8-a5cc-f745e15eee43
2009-12-22 12:05:55 +00:00
cltbld
034d214153 "Automated configuration bump, release for xulrunner 1.9.0.17build1"
git-svn-id: svn://10.0.0.236/branches/release@259281 18797224-902f-48f8-a5cc-f745e15eee43
2009-12-22 11:53:54 +00:00
cltbld
71605a6a9a "Automated configuration bump, release for xulrunner 1.9.0.17build1"
git-svn-id: svn://10.0.0.236/branches/release@259280 18797224-902f-48f8-a5cc-f745e15eee43
2009-12-22 11:47:31 +00:00
cltbld
961845c47e "Automated configuration bump, release for firefox 3.0.17build1"
git-svn-id: svn://10.0.0.236/branches/release@259275 18797224-902f-48f8-a5cc-f745e15eee43
2009-12-21 23:38:05 +00:00
cltbld
1c627c7812 "Automated configuration bump, release for xulrunner 1.9.0.16build2"
git-svn-id: svn://10.0.0.236/branches/release@259138 18797224-902f-48f8-a5cc-f745e15eee43
2009-12-01 23:04:56 +00:00
cltbld
7f17e27cf0 "Automated configuration bump, release for firefox 3.0.16build1"
git-svn-id: svn://10.0.0.236/branches/release@259107 18797224-902f-48f8-a5cc-f745e15eee43
2009-11-30 18:25:22 +00:00
cltbld
c17680a4e5 "Automated configuration bump, release for xulrunner 1.9.0.15build1"
git-svn-id: svn://10.0.0.236/branches/release@258626 18797224-902f-48f8-a5cc-f745e15eee43
2009-10-07 17:47:36 +00:00
cltbld
9bf6ea3c31 "Automated configuration bump, release for firefox 3.0.15build1"
git-svn-id: svn://10.0.0.236/branches/release@258610 18797224-902f-48f8-a5cc-f745e15eee43
2009-10-06 18:00:29 +00:00
cltbld
801a8d9999 "Automated configuration bump, release for xulrunner 1.9.0.14build1"
git-svn-id: svn://10.0.0.236/branches/release@258235 18797224-902f-48f8-a5cc-f745e15eee43
2009-08-25 22:13:30 +00:00
cltbld
1ce29d2ed0 "Automated configuration bump, release for xulrunner 1.9.0.14build1"
git-svn-id: svn://10.0.0.236/branches/release@258231 18797224-902f-48f8-a5cc-f745e15eee43
2009-08-25 21:16:07 +00:00
cltbld
cf5e912905 "Automated configuration bump, release for xulrunner 1.9.0.14build1"
git-svn-id: svn://10.0.0.236/branches/release@258230 18797224-902f-48f8-a5cc-f745e15eee43
2009-08-25 20:42:20 +00:00
cltbld
991f66a42c "Automated configuration bump, release for firefox 3.0.14build1"
git-svn-id: svn://10.0.0.236/branches/release@258212 18797224-902f-48f8-a5cc-f745e15eee43
2009-08-24 17:38:55 +00:00
cltbld
0b3425a639 "Automated configuration bump, release for xulrunner 1.9.0.13build1"
git-svn-id: svn://10.0.0.236/branches/release@257896 18797224-902f-48f8-a5cc-f745e15eee43
2009-07-31 17:00:01 +00:00
cltbld
095ae364d7 "Automated configuration bump, release for xulrunner 1.9.0.13build1"
git-svn-id: svn://10.0.0.236/branches/release@257895 18797224-902f-48f8-a5cc-f745e15eee43
2009-07-31 16:20:22 +00:00
cltbld
4ee5de5033 "Automated configuration bump, release for firefox 3.0.13build1"
git-svn-id: svn://10.0.0.236/branches/release@257891 18797224-902f-48f8-a5cc-f745e15eee43
2009-07-31 04:22:44 +00:00
cltbld
ae9b838489 "Automated configuration bump, release for firefox 3.0.13build1"
git-svn-id: svn://10.0.0.236/branches/release@257890 18797224-902f-48f8-a5cc-f745e15eee43
2009-07-31 04:14:38 +00:00
cltbld
188ea73fac "Automated configuration bump, release for xulrunner 1.9.0.12build1"
git-svn-id: svn://10.0.0.236/branches/release@257654 18797224-902f-48f8-a5cc-f745e15eee43
2009-07-07 23:15:10 +00:00
cltbld
3ad6129780 "Automated configuration bump, release for firefox 3.0.12build1"
git-svn-id: svn://10.0.0.236/branches/release@257641 18797224-902f-48f8-a5cc-f745e15eee43
2009-07-06 16:57:15 +00:00
cltbld
d1565f139b "Automated configuration bump, release for xulrunner 1.9.0.11build2"
git-svn-id: svn://10.0.0.236/branches/release@257383 18797224-902f-48f8-a5cc-f745e15eee43
2009-06-03 20:20:54 +00:00
cltbld
cb97343418 "Automated configuration bump, release for firefox 3.0.11build1"
git-svn-id: svn://10.0.0.236/branches/release@257227 18797224-902f-48f8-a5cc-f745e15eee43
2009-05-19 15:33:49 +00:00
cltbld
cf34e1edd4 "Automated configuration bump, release for xulrunner 1.9.0.10build1"
git-svn-id: svn://10.0.0.236/branches/release@257170 18797224-902f-48f8-a5cc-f745e15eee43
2009-05-12 15:53:22 +00:00
cltbld
dfd8c7a9f9 "Automated configuration bump, release for firefox 3.0.10build1"
git-svn-id: svn://10.0.0.236/branches/release@257037 18797224-902f-48f8-a5cc-f745e15eee43
2009-04-23 22:42:57 +00:00
cltbld
d104ac4be2 "Automated configuration bump, release for firefox 3.0.10build1"
git-svn-id: svn://10.0.0.236/branches/release@257036 18797224-902f-48f8-a5cc-f745e15eee43
2009-04-23 22:36:24 +00:00
cltbld
6dece5a779 "Automated configuration bump, release for firefox 3.0.9build1"
git-svn-id: svn://10.0.0.236/branches/release@256823 18797224-902f-48f8-a5cc-f745e15eee43
2009-04-06 16:38:02 +00:00
cltbld
6334f72206 "Automated configuration bump, release for firefox 3.0.8build1"
git-svn-id: svn://10.0.0.236/branches/release@256697 18797224-902f-48f8-a5cc-f745e15eee43
2009-03-26 00:07:38 +00:00
cltbld
c308e60f30 "Automated configuration bump, release for firefox 3.0.8build1"
git-svn-id: svn://10.0.0.236/branches/release@256696 18797224-902f-48f8-a5cc-f745e15eee43
2009-03-26 00:00:43 +00:00
cltbld
d7b0531318 "Automated configuration bump, release for xulrunner 1.9.0.7build1"
git-svn-id: svn://10.0.0.236/branches/release@256531 18797224-902f-48f8-a5cc-f745e15eee43
2009-03-13 16:47:56 +00:00
cltbld
eeb4968977 "Automated configuration bump, release for firefox 3.0.7build1"
git-svn-id: svn://10.0.0.236/branches/release@256242 18797224-902f-48f8-a5cc-f745e15eee43
2009-02-17 18:23:00 +00:00
cltbld
d78a15e213 "Automated configuration bump, release for xulrunner 1.9.0.6build1"
git-svn-id: svn://10.0.0.236/branches/release@256093 18797224-902f-48f8-a5cc-f745e15eee43
2009-02-04 19:32:51 +00:00
cltbld
45d22db0fb "Automated configuration bump, release for firefox 3.0.6build1"
git-svn-id: svn://10.0.0.236/branches/release@255853 18797224-902f-48f8-a5cc-f745e15eee43
2009-01-19 20:12:39 +00:00
cltbld
6620cb4f52 "Automated configuration bump, release for firefox 3.0.6build1"
git-svn-id: svn://10.0.0.236/branches/release@255852 18797224-902f-48f8-a5cc-f745e15eee43
2009-01-19 20:07:23 +00:00
cltbld
93bf4cbbfe "Automated configuration bump, release for xulrunner 1.9.0.5build1"
git-svn-id: svn://10.0.0.236/branches/release@255642 18797224-902f-48f8-a5cc-f745e15eee43
2008-12-26 13:53:37 +00:00
cltbld
a460954b54 "Automated configuration bump, release for firefox 3.0.5build1"
git-svn-id: svn://10.0.0.236/branches/release@255293 18797224-902f-48f8-a5cc-f745e15eee43
2008-12-02 05:08:39 +00:00
cltbld
4b4a7b0a1c "Automated configuration bump, release for firefox 3.0.5build1"
git-svn-id: svn://10.0.0.236/branches/release@255292 18797224-902f-48f8-a5cc-f745e15eee43
2008-12-02 05:03:03 +00:00
cltbld
2045a62f5f "Automated configuration bump, release for xulrunner 1.9.0.4build1"
git-svn-id: svn://10.0.0.236/branches/release@255030 18797224-902f-48f8-a5cc-f745e15eee43
2008-11-13 20:28:50 +00:00
cltbld
dc69be5e0f "Automated configuration bump, release for xulrunner 1.9.0.4build1"
git-svn-id: svn://10.0.0.236/branches/release@255026 18797224-902f-48f8-a5cc-f745e15eee43
2008-11-13 18:37:45 +00:00
cltbld
8839bff2be "Automated configuration bump, release for firefox 3.0.4build1"
git-svn-id: svn://10.0.0.236/branches/release@254824 18797224-902f-48f8-a5cc-f745e15eee43
2008-10-30 03:22:46 +00:00
cltbld
7b8d870520 "Automated configuration bump, release for xulrunner 1.9.0.3build1"
git-svn-id: svn://10.0.0.236/branches/release@254438 18797224-902f-48f8-a5cc-f745e15eee43
2008-09-26 04:38:52 +00:00
cltbld
bd80e8e97b "Automated configuration bump, release for xulrunner 1.9.0.3build1"
git-svn-id: svn://10.0.0.236/branches/release@254437 18797224-902f-48f8-a5cc-f745e15eee43
2008-09-26 01:14:19 +00:00
cltbld
7b799934e7 "Automated configuration bump, release for firefox 3.0.3build1"
git-svn-id: svn://10.0.0.236/branches/release@254411 18797224-902f-48f8-a5cc-f745e15eee43
2008-09-24 21:33:22 +00:00
cltbld
7b56b48f8b "Automated configuration bump, release for xulrunner 1.9.0.2build1"
git-svn-id: svn://10.0.0.236/branches/release@254386 18797224-902f-48f8-a5cc-f745e15eee43
2008-09-24 14:08:27 +00:00
cltbld
34ac30982e "Automated configuration bump, release for firefox 3.0.2build1"
git-svn-id: svn://10.0.0.236/branches/release@253878 18797224-902f-48f8-a5cc-f745e15eee43
2008-08-27 15:20:11 +00:00
nrthomas%gmail.com
fb63af635f Bug 445991, use Thunderbird.app on mac since not all the branding changes made the cutoff
git-svn-id: svn://10.0.0.236/branches/release@253324 18797224-902f-48f8-a5cc-f745e15eee43
2008-07-29 04:58:25 +00:00
cltbld
9e6c560747 "Automated configuration bump, release for thunderbird 3.0a2build1"
git-svn-id: svn://10.0.0.236/branches/release@253267 18797224-902f-48f8-a5cc-f745e15eee43
2008-07-25 01:26:22 +00:00
nrthomas%gmail.com
96fbdb013d Bug 445991, update release configs for branding changes, p=gozer, r=me
git-svn-id: svn://10.0.0.236/branches/release@253259 18797224-902f-48f8-a5cc-f745e15eee43
2008-07-24 21:57:08 +00:00
nrthomas%gmail.com
0d8d580d24 Bug 441294, setup t'bird builds on release automation, r=bhearsum
git-svn-id: svn://10.0.0.236/branches/release@253258 18797224-902f-48f8-a5cc-f745e15eee43
2008-07-24 21:20:34 +00:00
cltbld
6e2a9397d2 "Automated configuration bump, release for xulrunner 1.9.0.1build1"
git-svn-id: svn://10.0.0.236/branches/release@253234 18797224-902f-48f8-a5cc-f745e15eee43
2008-07-24 13:14:52 +00:00
cltbld
efeae1d426 "Automated configuration bump, release for xulrunner 1.9.0.1build1"
git-svn-id: svn://10.0.0.236/branches/release@253233 18797224-902f-48f8-a5cc-f745e15eee43
2008-07-24 13:08:58 +00:00
ted.mielczarek%gmail.com
bdedd3cda1 bug 444033 - drop throttled/enabled percentage of Windows client to 10% r=bhearsum
git-svn-id: svn://10.0.0.236/branches/release@252958 18797224-902f-48f8-a5cc-f745e15eee43
2008-07-10 15:37:34 +00:00
cltbld
0915848efe "Automated configuration bump, release for firefox 3.0.1build1"
git-svn-id: svn://10.0.0.236/branches/release@252794 18797224-902f-48f8-a5cc-f745e15eee43
2008-07-02 13:19:56 +00:00
cltbld
8a14f98c41 "Automated configuration bump, release for xulrunner 1.9rc3build1"
git-svn-id: svn://10.0.0.236/branches/release@252226 18797224-902f-48f8-a5cc-f745e15eee43
2008-06-10 20:20:48 +00:00
mark.finkle%gmail.com
c991674af0 b=435460, r=nthomas. enable jemalloc on release branch
git-svn-id: svn://10.0.0.236/branches/release@252219 18797224-902f-48f8-a5cc-f745e15eee43
2008-06-10 14:34:58 +00:00
cltbld
b32f67bbcc "Automated configuration bump, release for firefox 3.0rc3build1"
git-svn-id: svn://10.0.0.236/branches/release@252213 18797224-902f-48f8-a5cc-f745e15eee43
2008-06-10 11:00:42 +00:00
nrthomas%gmail.com
7ffebcee9f Bug 435460, enable SDK and push the files correctly for XULrunner releases, r=bhearsum
git-svn-id: svn://10.0.0.236/branches/release@252079 18797224-902f-48f8-a5cc-f745e15eee43
2008-06-03 14:24:08 +00:00
nrthomas%gmail.com
51e14c93a9 Bug 435460, enable symbol generation and upload, with source server support, r=bhearsum & carrying over r=ted on the nightly config for source server
git-svn-id: svn://10.0.0.236/branches/release@251950 18797224-902f-48f8-a5cc-f745e15eee43
2008-05-29 22:04:23 +00:00
cltbld
c5ef8c5224 "Automated configuration bump, release for xulrunner 1.9rc2build1"
git-svn-id: svn://10.0.0.236/branches/release@251948 18797224-902f-48f8-a5cc-f745e15eee43
2008-05-29 21:58:55 +00:00
cltbld
95ea8913db "Automated configuration bump, release for xulrunner 1.9rc2build1"
git-svn-id: svn://10.0.0.236/branches/release@251947 18797224-902f-48f8-a5cc-f745e15eee43
2008-05-29 21:53:31 +00:00
cltbld
e3cd6d1fc1 "Automated configuration bump, release for firefox 3.0rc2build1"
git-svn-id: svn://10.0.0.236/branches/release@251923 18797224-902f-48f8-a5cc-f745e15eee43
2008-05-29 10:37:05 +00:00
cltbld
9c8381e790 "Automated configuration bump, release for firefox 3.0rc2build1"
git-svn-id: svn://10.0.0.236/branches/release@251921 18797224-902f-48f8-a5cc-f745e15eee43
2008-05-29 10:22:47 +00:00
cltbld
f04cd31af4 "Automated configuration bump, release for firefox 3.0rc1build1"
git-svn-id: svn://10.0.0.236/branches/release@251543 18797224-902f-48f8-a5cc-f745e15eee43
2008-05-12 09:43:29 +00:00
cltbld
2d24a33b99 "Automated configuration bump, release for thunderbird 3.0a1build1"
git-svn-id: svn://10.0.0.236/branches/release@251364 18797224-902f-48f8-a5cc-f745e15eee43
2008-05-07 22:19:07 +00:00
cltbld
166e784f13 "Automated configuration bump, release for thunderbird 3.0a1build1"
git-svn-id: svn://10.0.0.236/branches/release@251361 18797224-902f-48f8-a5cc-f745e15eee43
2008-05-07 21:51:06 +00:00
nrthomas%gmail.com
3fe9a4989d Bug 431788, followup to fix quoting
git-svn-id: svn://10.0.0.236/branches/release@251358 18797224-902f-48f8-a5cc-f745e15eee43
2008-05-07 21:34:26 +00:00
cltbld
648068e289 "Automated configuration bump, release for thunderbird 3.0a1build1"
git-svn-id: svn://10.0.0.236/branches/release@251356 18797224-902f-48f8-a5cc-f745e15eee43
2008-05-07 21:21:19 +00:00
nrthomas%gmail.com
5ff8ee481d Bug 431788, add configs on release branch for Tb3.0a1, r=bhearsum
git-svn-id: svn://10.0.0.236/branches/release@251338 18797224-902f-48f8-a5cc-f745e15eee43
2008-05-07 17:40:08 +00:00
nrthomas%gmail.com
63fa433d8e Bug 428074, change update channel to release for 3.0 RC builds, r=bhearsum
git-svn-id: svn://10.0.0.236/branches/release@251003 18797224-902f-48f8-a5cc-f745e15eee43
2008-04-30 20:51:24 +00:00
(no author)
76c7e61a68 This commit was manufactured by cvs2svn to create branch 'release'.
git-svn-id: svn://10.0.0.236/branches/release@250880 18797224-902f-48f8-a5cc-f745e15eee43
2008-04-28 18:04:07 +00:00
ted.mielczarek%gmail.com
862b59a69e bug 424240, bug 428615 - env vars for srcsrv support. patches by Lukas Blakk <lukasblakk@gmail.com>, r=me, a=beltzner, r=nthomas for landing on release branch
git-svn-id: svn://10.0.0.236/branches/release@250254 18797224-902f-48f8-a5cc-f745e15eee43
2008-04-15 10:37:23 +00:00
cltbld
c522f79ece "Automated configuration bump, release for xulrunner 3.0b4rc1"
git-svn-id: svn://10.0.0.236/branches/release@250128 18797224-902f-48f8-a5cc-f745e15eee43
2008-04-12 18:05:30 +00:00
cltbld
e592827a71 "Automated configuration bump, release for xulrunner 3.0b4rc1"
git-svn-id: svn://10.0.0.236/branches/release@250126 18797224-902f-48f8-a5cc-f745e15eee43
2008-04-12 17:11:33 +00:00
cltbld
fe7436ebaf "Automated configuration bump, release for xulrunner 3.0b4rc1"
git-svn-id: svn://10.0.0.236/branches/release@250118 18797224-902f-48f8-a5cc-f745e15eee43
2008-04-12 08:06:06 +00:00
cltbld
e1a7f7e17d "Automated configuration bump, release for xulrunner 3.0b4rc1"
git-svn-id: svn://10.0.0.236/branches/release@250098 18797224-902f-48f8-a5cc-f745e15eee43
2008-04-11 22:45:51 +00:00
ted.mielczarek%gmail.com
3e048fdef2 bug 424960 - only enable crash reporting for X% of release builds--set enable percent to 25% on fx-win32-tbox. r=rhelmer
git-svn-id: svn://10.0.0.236/branches/release@249803 18797224-902f-48f8-a5cc-f745e15eee43
2008-04-08 14:54:02 +00:00
nrthomas%gmail.com
81cf65bb4a Bug 421012, global s/md5/sha1/ for update hash function (even for configs that don't use it)
git-svn-id: svn://10.0.0.236/branches/release@248902 18797224-902f-48f8-a5cc-f745e15eee43
2008-03-31 19:35:14 +00:00
cltbld
561dfdcf56 "Automated configuration bump, release for firefox 3.0b5rc1"
git-svn-id: svn://10.0.0.236/branches/release@248589 18797224-902f-48f8-a5cc-f745e15eee43
2008-03-26 11:52:47 +00:00
rhelmer%mozilla.com
671a47eab2 set JAVA_HOME explicitly b=415180 r=bsmedberg
git-svn-id: svn://10.0.0.236/branches/release@248013 18797224-902f-48f8-a5cc-f745e15eee43
2008-03-17 19:35:11 +00:00
rhelmer%mozilla.com
46e82a1ece bustage fix, missing semicolon
git-svn-id: svn://10.0.0.236/branches/release@247216 18797224-902f-48f8-a5cc-f745e15eee43
2008-03-06 19:15:33 +00:00
rhelmer%mozilla.com
84ecf071e1 create xulrunner release branch for use with release automation b=415180 r=nthomas
git-svn-id: svn://10.0.0.236/branches/release@247196 18797224-902f-48f8-a5cc-f745e15eee43
2008-03-06 16:51:57 +00:00
cltbld
7e3a0bcda8 "Automated configuration bump, release for firefox 3.0b4rc1"
git-svn-id: svn://10.0.0.236/branches/release@246960 18797224-902f-48f8-a5cc-f745e15eee43
2008-03-04 00:29:17 +00:00
nrthomas%gmail.com
faab209902 Bug 418926, config changes for PGO on releases, p=joduinn, r=me
git-svn-id: svn://10.0.0.236/branches/release@246953 18797224-902f-48f8-a5cc-f745e15eee43
2008-03-03 23:07:18 +00:00
rhelmer%mozilla.com
891d00f3cf take optimizations from nightlies, b=409880, r=nthomas
git-svn-id: svn://10.0.0.236/branches/release@244936 18797224-902f-48f8-a5cc-f745e15eee43
2008-02-05 18:20:00 +00:00
cltbld
41c933f51e "Automated configuration bump, release for firefox 3.0b3rc1"
git-svn-id: svn://10.0.0.236/branches/release@244908 18797224-902f-48f8-a5cc-f745e15eee43
2008-02-05 02:57:15 +00:00
cltbld
2aa37796fa "Automated configuration bump, release for firefox 3.0b3rc1"
git-svn-id: svn://10.0.0.236/branches/release@244906 18797224-902f-48f8-a5cc-f745e15eee43
2008-02-05 02:41:51 +00:00
(no author)
f7ca841056 This commit was manufactured by cvs2svn to create branch 'release'.
git-svn-id: svn://10.0.0.236/branches/release@244825 18797224-902f-48f8-a5cc-f745e15eee43
2008-02-03 20:43:46 +00:00
rhelmer%mozilla.com
232773f5f4 set WIN32_REDIST_DIR as env var instead b=407988
git-svn-id: svn://10.0.0.236/branches/release@240897 18797224-902f-48f8-a5cc-f745e15eee43
2007-12-12 02:52:43 +00:00
rhelmer%mozilla.com
76874b45d1 set WIN32_REDIST_DIR in mozconfig b=407988 r=mconnor
git-svn-id: svn://10.0.0.236/branches/release@240885 18797224-902f-48f8-a5cc-f745e15eee43
2007-12-12 01:08:07 +00:00
cltbld
c56f7bb4fb "Automated configuration bump, release for firefox 3.0b2rc1"
git-svn-id: svn://10.0.0.236/branches/release@240749 18797224-902f-48f8-a5cc-f745e15eee43
2007-12-10 20:37:25 +00:00
bhearsum%mozilla.com
8a6ccb43c2 bug 406016: add symbol server config variables to 'release' tinder-config.pl's. r=cf patch=me
git-svn-id: svn://10.0.0.236/branches/release@240119 18797224-902f-48f8-a5cc-f745e15eee43
2007-11-29 18:06:33 +00:00
nrthomas%gmail.com
19f1281ca6 Bug 401741, release build configs for 3.0b1, r=coop
git-svn-id: svn://10.0.0.236/branches/release@238601 18797224-902f-48f8-a5cc-f745e15eee43
2007-11-06 22:32:58 +00:00
nrthomas%gmail.com
b0ea7ee81e Bug 402724, sync en-US nightly, en-US releases & l10n nightly configs for easier diffing (Firefox Trunk only), r=coop
git-svn-id: svn://10.0.0.236/branches/release@238589 18797224-902f-48f8-a5cc-f745e15eee43
2007-11-06 18:06:36 +00:00
bhearsum%mozilla.com
d7084ee4fd bug 402541: add CONFIG lines to tinder-config.pl's on release tag. r=cf, patch=me
git-svn-id: svn://10.0.0.236/branches/release@238538 18797224-902f-48f8-a5cc-f745e15eee43
2007-11-05 16:30:10 +00:00
preed%mozilla.com
6893804145 Point the release tinder configs at the new (MozillaBuild) location of blat.
git-svn-id: svn://10.0.0.236/branches/release@235921 18797224-902f-48f8-a5cc-f745e15eee43
2007-09-12 21:05:24 +00:00
cltbld
2b283f97a6 Bug 394037, tinderbox config bumps for gecko 1.9a8, me=joduinn
git-svn-id: svn://10.0.0.236/branches/release@235533 18797224-902f-48f8-a5cc-f745e15eee43
2007-09-12 08:36:48 +00:00
rhelmer%mozilla.com
3a2ac33def make buildtree configurable by bootstrap b=391968 r=cf
git-svn-id: svn://10.0.0.236/branches/release@232425 18797224-902f-48f8-a5cc-f745e15eee43
2007-08-21 00:22:10 +00:00
nrthomas%gmail.com
dc6eef1493 Bug 390514, tinderbox config bumps for gecko 1.9a7, plus pull in the mozconfig trimming already in nightly builds from bug 387181, and fix up the comment headers, r=coop
git-svn-id: svn://10.0.0.236/branches/release@231311 18797224-902f-48f8-a5cc-f745e15eee43
2007-08-02 15:28:02 +00:00
nrthomas%gmail.com
bec02b88eb Bug 386114, changes for 1.9a6 from libxul landing, r=mconnor
git-svn-id: svn://10.0.0.236/branches/release@229006 18797224-902f-48f8-a5cc-f745e15eee43
2007-06-29 15:09:48 +00:00
nrthomas%gmail.com
4091110aaf Bug 386114, update linux mozconfig for 1.9a6 & tinderbox change, p=rhelmer, r=cf
git-svn-id: svn://10.0.0.236/branches/release@229000 18797224-902f-48f8-a5cc-f745e15eee43
2007-06-29 13:34:54 +00:00
nrthomas%gmail.com
a2f8f6afa8 Bug 386114, push Breakpad symbols on Linux for 1.9a6, r=luser
git-svn-id: svn://10.0.0.236/branches/release@228998 18797224-902f-48f8-a5cc-f745e15eee43
2007-06-29 11:35:23 +00:00
rhelmer%mozilla.com
a00b159b55 Bug 386114: Tinderconfig bumps for the 1.9a6 release. patch=joduinn, r=rhelmer.
git-svn-id: svn://10.0.0.236/branches/release@228912 18797224-902f-48f8-a5cc-f745e15eee43
2007-06-28 00:47:48 +00:00
ccooper%deadsquid.com
4ca79d331e b=373373
-set MofoRoot


git-svn-id: svn://10.0.0.236/branches/release@228845 18797224-902f-48f8-a5cc-f745e15eee43
2007-06-27 15:26:13 +00:00
preed%mozilla.com
3ffbe5b70c Bug 382873: Tinderconfig bumps for the 1.9a5 release. patch=joduinn, r=preed.
git-svn-id: svn://10.0.0.236/branches/release@227387 18797224-902f-48f8-a5cc-f745e15eee43
2007-06-01 22:31:55 +00:00
nrthomas%gmail.com
01bac7c6a0 Enable pushing Breakpad symbols to server on release builds, b=378905, r=preed
git-svn-id: svn://10.0.0.236/branches/release@225521 18797224-902f-48f8-a5cc-f745e15eee43
2007-05-03 10:11:36 +00:00
rhelmer%mozilla.com
730d946722 config changes for gecko1.9a4 b=378905 r=cf
git-svn-id: svn://10.0.0.236/branches/release@225105 18797224-902f-48f8-a5cc-f745e15eee43
2007-04-26 20:07:04 +00:00
preed%mozilla.com
a2d0a7429a For the 1.9a3 release, make sure all the mozconfigs have -j1, bump tag and milestone, and add tinder-config options to build the breakbag symbols, but NOT push them up (yet).
git-svn-id: svn://10.0.0.236/branches/release@222228 18797224-902f-48f8-a5cc-f745e15eee43
2007-03-23 03:14:00 +00:00
rhelmer%mozilla.com
01092a0067 add appv/extv r=preed
git-svn-id: svn://10.0.0.236/branches/release@219626 18797224-902f-48f8-a5cc-f745e15eee43
2007-02-07 01:59:15 +00:00
rhelmer%mozilla.com
589c20624d fix comments r=preed b=369554
git-svn-id: svn://10.0.0.236/branches/release@219622 18797224-902f-48f8-a5cc-f745e15eee43
2007-02-07 00:52:45 +00:00
rhelmer%mozilla.com
42f2431f28 checking in configs so builds can get started, b=369554 r=rhelmer
git-svn-id: svn://10.0.0.236/branches/release@219615 18797224-902f-48f8-a5cc-f745e15eee43
2007-02-06 23:54:47 +00:00
rhelmer%mozilla.com
771c30f1e3 disable non-alive tests on release branch b=362418 r=preed
git-svn-id: svn://10.0.0.236/branches/release@216432 18797224-902f-48f8-a5cc-f745e15eee43
2006-12-04 20:03:17 +00:00
rhelmer%mozilla.com
e62ffa43cc disable update packaging for gecko 1.9a1 r=preed b=362418
git-svn-id: svn://10.0.0.236/branches/release@216272 18797224-902f-48f8-a5cc-f745e15eee43
2006-12-01 18:50:28 +00:00
rhelmer%mozilla.com
0b87c1db22 remove unsupported optimizations r=vlad
git-svn-id: svn://10.0.0.236/branches/release@216214 18797224-902f-48f8-a5cc-f745e15eee43
2006-12-01 04:27:03 +00:00
rhelmer%mozilla.com
da00a15686 use different code name for Mac r=preed b=362418
git-svn-id: svn://10.0.0.236/branches/release@216213 18797224-902f-48f8-a5cc-f745e15eee43
2006-12-01 04:11:29 +00:00
rhelmer%mozilla.com
9628510565 time stamps should not be used for release builds b=362418 r=preed
git-svn-id: svn://10.0.0.236/branches/release@216212 18797224-902f-48f8-a5cc-f745e15eee43
2006-12-01 03:50:24 +00:00
(no author)
65863d47ac This commit was manufactured by cvs2svn to create branch 'release'.
git-svn-id: svn://10.0.0.236/branches/release@216204 18797224-902f-48f8-a5cc-f745e15eee43
2006-12-01 02:21:24 +00:00
83 changed files with 2519 additions and 15780 deletions

View File

@@ -0,0 +1,26 @@
#
## hostname: fx-linux-tbox
## uname: Linux fx-linux-tbox.build.mozilla.org 2.6.18-8.el5 #1 SMP Thu Mar 15 19:57:35 EDT 2007 i686 i686 i386 GNU/Linux
#
export CFLAGS="-gstabs+"
export CXXFLAGS="-gstabs+"
mk_add_options MOZ_CO_PROJECT=browser
mk_add_options PROFILE_GEN_SCRIPT=@TOPSRCDIR@/build/profile_pageloader.pl
mk_add_options MOZ_CO_MODULE="mozilla/tools/update-packaging"
mk_add_options MOZ_MAKE_FLAGS="-j1"
ac_add_options --enable-application=browser
ac_add_options --enable-update-channel=release
ac_add_options --enable-update-packaging
# Don't add explicit optimize flags here, set them in configure.in, see bug 407794.
ac_add_options --enable-optimize
ac_add_options --disable-debug
ac_add_options --disable-tests
ac_add_options --enable-official-branding
CC=/tools/gcc/bin/gcc
CXX=/tools/gcc/bin/g++

View File

@@ -0,0 +1,268 @@
#
## hostname: fx-linux-tbox
## uname: Linux fx-linux-tbox.build.mozilla.org 2.6.18-8.el5 #1 SMP Thu Mar 15 19:57:35 EDT 2007 i686 i686 i386 GNU/Linux
#
#- tinder-config.pl - Tinderbox configuration file.
#- Uncomment the variables you need to set.
#- The default values are the same as the commented variables.
$ENV{CVS_RSH} = "ssh";
$ENV{MOZ_CRASHREPORTER_NO_REPORT} = '1';
# To ensure Talkback client builds properly on some Linux boxen where LANG
# is set to "en_US.UTF-8" by default, override that setting here by setting
# it to "en_US.iso885915" (the setting on ocean). Proper fix is to update
# where xrestool is called in the build system so that 'LANG=C' in its
# environment, according to bryner.
$ENV{LANG} = "en_US.iso885915";
# $ENV{MOZ_PACKAGE_MSI}
#-----------------------------------------------------------------------------
# Default: 0
# Values: 0 | 1
# Purpose: Controls whether a MSI package is made.
# Requires: Windows and a local MakeMSI installation.
#$ENV{MOZ_PACKAGE_MSI} = 0;
# $ENV{MOZ_SYMBOLS_TRANSFER_TYPE}
#-----------------------------------------------------------------------------
# Default: scp
# Values: scp | rsync
# Purpose: Use scp or rsync to transfer symbols to the Talkback server.
# Requires: The selected type requires the command be available both locally
# and on the Talkback server.
#$ENV{MOZ_SYMBOLS_TRANSFER_TYPE} = "scp";
#- PLEASE FILL THIS IN WITH YOUR PROPER EMAIL ADDRESS
$BuildAdministrator = 'build@mozilla.org';
#$BuildAdministrator = "$ENV{USER}\@$ENV{HOST}";
#$BuildAdministrator = ($ENV{USER} || "cltbld") . "\@" . ($ENV{HOST} || "dhcp");
#- You'll need to change these to suit your machine's needs
$DisplayServer = ':0.0';
#- Default values of command-line opts
#-
#$BuildDepend = 1; # Depend or Clobber
#$BuildDebug = 0; # Debug or Opt (Darwin)
#$ReportStatus = 1; # Send results to server, or not
#$ReportFinalStatus = 1; # Finer control over $ReportStatus.
$UseTimeStamp = 0; # Use the CVS 'pull-by-timestamp' option, or not
#$BuildOnce = 0; # Build once, don't send results to server
#$TestOnly = 0; # Only run tests, don't pull/build
#$BuildEmbed = 0; # After building seamonkey, go build embed app.
#$SkipMozilla = 0; # Use to debug post-mozilla.pl scripts.
#$BuildLocales = 0; # Do l10n packaging?
# Tests
$CleanProfile = 1;
#$ResetHomeDirForTests = 1;
$ProductName = "Firefox";
$VendorName = 'Mozilla';
$RunMozillaTests = 1; # Allow turning off of all tests if needed.
$RegxpcomTest = 1;
$AliveTest = 1;
#$JavaTest = 0;
#$ViewerTest = 0;
#$BloatTest = 0; # warren memory bloat test
#$BloatTest2 = 0; # dbaron memory bloat test, require tracemalloc
#$DomToTextConversionTest = 0;
#$XpcomGlueTest = 0;
$CodesizeTest = 0; # Z, require mozilla/tools/codesighs
$EmbedCodesizeTest = 0; # mZ, require mozilla/tools/codesigns
#$MailBloatTest = 0;
#$EmbedTest = 0; # Assumes you wanted $BuildEmbed=1
$LayoutPerformanceTest = 0; # Tp
$DHTMLPerformanceTest = 0; # Tdhtml
#$QATest = 0;
#$XULWindowOpenTest = 0; # Txul
$StartupPerformanceTest = 0; # Ts
$TestsPhoneHome = 0; # Should test report back to server?
$GraphNameOverride = 'fx-linux-tbox';
# $results_server
#----------------------------------------------------------------------------
# Server on which test results will be accessible. This was originally tegu,
# then became axolotl. Once we moved services from axolotl, it was time
# to give this service its own hostname to make future transitions easier.
# - cmp@mozilla.org
#$results_server = "build-graphs.mozilla.org";
#$pageload_server = "spider"; # localhost
$pageload_server = "pageload.build.mozilla.org";
#
# Timeouts, values are in seconds.
#
#$CVSCheckoutTimeout = 3600;
#$CreateProfileTimeout = 45;
#$RegxpcomTestTimeout = 120;
#$AliveTestTimeout = 45;
#$ViewerTestTimeout = 45;
#$EmbedTestTimeout = 45;
#$BloatTestTimeout = 120; # seconds
#$MailBloatTestTimeout = 120; # seconds
#$JavaTestTimeout = 45;
#$DomTestTimeout = 45; # seconds
#$XpcomGlueTestTimeout = 15;
#$CodesizeTestTimeout = 900; # seconds
#$CodesizeTestType = "auto"; # {"auto"|"base"}
#$LayoutPerformanceTestTimeout = 1200; # entire test, seconds
#$DHTMLPerformanceTestTimeout = 1200; # entire test, seconds
#$QATestTimeout = 1200; # entire test, seconds
#$LayoutPerformanceTestPageTimeout = 30000; # each page, ms
#$StartupPerformanceTestTimeout = 15; # seconds
#$XULWindowOpenTestTimeout = 150; # seconds
#$MozConfigFileName = 'mozconfig';
#$UseMozillaProfile = 1;
#$MozProfileName = 'default';
#- Set these to what makes sense for your system
#$Make = 'gmake'; # Must be GNU make
#$MakeOverrides = '';
#$mail = '/bin/mail';
#$CVS = 'cvs -q';
#$CVSCO = 'checkout -P';
# win32 usually doesn't have /bin/mail
#$blat = 'c:/nstools/bin/blat';
#$use_blat = 0;
# Set moz_cvsroot to something like:
# :pserver:$ENV{USER}%netscape.com\@cvs.mozilla.org:/cvsroot
# :pserver:anonymous\@cvs-mirror.mozilla.org:/cvsroot
#
# Note that win32 may not need \@, depends on ' or ".
# :pserver:$ENV{USER}%netscape.com@cvs.mozilla.org:/cvsroot
#$moz_cvsroot = $ENV{CVSROOT};
# CONFIG: $moz_cvsroot = '%mozillaCvsroot%';
$moz_cvsroot = 'cltbld@cvs.mozilla.org:/cvsroot';
#- Set these proper values for your tinderbox server
#$Tinderbox_server = 'tinderbox-daemon@tinderbox.mozilla.org';
# Allow for non-client builds, e.g. camino.
#$moz_client_mk = 'client.mk';
#- Set if you want to build in a separate object tree
$ObjDir = 'obj-fx-trunk';
# Extra build name, if needed.
$BuildNameExtra = 'Release';
# User comment, eg. ip address for dhcp builds.
# ex: $UserComment = "ip = 208.12.36.108";
#$UserComment = 0;
#-
#- The rest should not need to be changed
#-
#- Minimum wait period from start of build to start of next build in minutes.
#$BuildSleep = 10;
#- Until you get the script working. When it works,
#- change to the tree you're actually building
# CONFIG: $BuildTree = '%buildTree%';
$BuildTree = 'MozillaRelease';
#$BuildName = '';
# CONFIG: $BuildTag = '%productTag%_RELEASE';
$BuildTag = 'FIREFOX_3_0_19_RELEASE';
#$BuildConfigDir = 'mozilla/config';
#$Topsrcdir = 'mozilla';
$BinaryName = 'firefox-bin';
#
# For embedding app, use:
#$EmbedBinaryName = 'TestGtkEmbed';
#$EmbedDistDir = 'dist/bin'
#$ShellOverride = ''; # Only used if the default shell is too stupid
#$ConfigureArgs = '';
#$ConfigureEnvArgs = '';
#$Compiler = 'gcc';
#$NSPRArgs = '';
#$ShellOverride = '';
# Release build options
$ReleaseBuild = 1;
$shiptalkback = 0;
$ReleaseToLatest = 0; # Push the release to latest-<milestone>?
$ReleaseToDated = 1; # Push the release to YYYY-MM-DD-HH-<milestone>?
$build_hour = 4;
$package_creation_path = "/browser/installer";
# needs setting for mac + talkback: $mac_bundle_path = "/browser/app";
$ssh_version = "2";
# CONFIG: $ssh_user = "%sshUser%";
$ssh_user = "cltbld";
# CONFIG: $ssh_server = "%sshServer%";
$ssh_server = "stage-old.mozilla.org";
$ftp_path = "/home/ftp/pub/firefox/nightly";
$url_path = "http://ftp.mozilla.org/pub/mozilla.org/firefox/nightly";
$tbox_ftp_path = "/home/ftp/pub/firefox/tinderbox-builds";
$tbox_url_path = "http://ftp.mozilla.org/pub/mozilla.org/firefox/tinderbox-builds";
# CONFIG: $milestone = "firefox%version%";
$milestone = "firefox3.0.19";
$notify_list = 'build-announce@mozilla.org';
$stub_installer = 0;
$sea_installer = 0;
$archive = 1;
$push_raw_xpis = 0;
$update_pushinfo = 0;
$update_package = 1;
$update_product = "Firefox";
$update_version = "trunk";
$update_platform = "Linux_x86-gcc3";
$update_hash = "sha1";
$update_filehost = 'ftp.mozilla.org';
$update_ver_file = 'browser/config/version.txt';
$crashreporter_buildsymbols = 1;
$crashreporter_pushsymbols = 1;
# CONFIG: $ENV{'SYMBOL_SERVER_HOST'} = '%symbolServer%';
$ENV{'SYMBOL_SERVER_HOST'} = 'dm-symbolpush01.mozilla.org';
# CONFIG: $ENV{'SYMBOL_SERVER_USER'} = '%symbolServerUser%';
$ENV{'SYMBOL_SERVER_USER'} = 'ffxbld';
# CONFIG: $ENV{'SYMBOL_SERVER_PATH'} = '%symbolServerPath%';
$ENV{'SYMBOL_SERVER_PATH'} = '/mnt/netapp/breakpad/symbols_ffx';
# CONFIG: $ENV{'SYMBOL_SERVER_SSH_KEY'} = '%symbolServerKey%';
$ENV{'SYMBOL_SERVER_SSH_KEY'} = '/home/cltbld/.ssh/ffxbld_dsa';
# Reboot the OS at the end of build-and-test cycle. This is primarily
# intended for Win9x, which can't last more than a few cycles before
# locking up (and testing would be suspect even after a couple of cycles).
# Right now, there is only code to force the reboot for Win9x, so even
# setting this to 1, will not have an effect on other platforms. Setting
# up win9x to automatically logon and begin running tinderbox is left
# as an exercise to the reader.
#$RebootSystem = 0;
# LogCompression specifies the type of compression used on the log file.
# Valid options are 'gzip', and 'bzip2'. Please make sure the binaries
# for 'gzip' or 'bzip2' are in the user's path before setting this
# option.
#$LogCompression = '';
# LogEncoding specifies the encoding format used for the logs. Valid
# options are 'base64', and 'uuencode'. If $LogCompression is set above,
# this needs to be set to 'base64' or 'uuencode' to ensure that the
# binary data is transferred properly.
#$LogEncoding = '';
# Prevent Extension Manager from spawning child processes during tests
# - processes that tbox scripts cannot kill.
#$ENV{NO_EM_RESTART} = '1';
# Do not build XForms
$BuildXForms = 0;

View File

@@ -0,0 +1,26 @@
#
## hostname: bm-xserve08.build.mozilla.org
## uname: Darwin bm-xserve08.build.mozilla.org 8.8.4 Darwin Kernel Version 8.8.4: Sun Oct 29 15:26:54 PST 2006; root:xnu-792.16.4.obj~1/RELEASE_I386 i386 i386
#
# symbols for breakpad
export CFLAGS="-g -gfull"
export CXXFLAGS="-g -gfull"
. $topsrcdir/build/macosx/universal/mozconfig
mk_add_options MOZ_MAKE_FLAGS="-j1"
mk_add_options MOZ_CO_MODULE="mozilla/tools/update-packaging"
mk_add_options MOZ_CO_PROJECT="browser"
mk_add_options MOZ_OBJDIR=@TOPSRCDIR@/../build/universal
ac_add_options --enable-application=browser
ac_add_options --enable-update-channel=release
# Don't add explicit optimize flags here, set them in configure.in, see bug 407794.
ac_add_options --enable-optimize
ac_add_options --disable-debug
ac_add_options --disable-tests
ac_add_options --enable-update-packaging
ac_add_options --enable-official-branding
ac_add_app_options ppc --enable-prebinding

View File

@@ -0,0 +1,267 @@
#
## hostname: bm-xserve08.build.mozilla.org
## uname: Darwin bm-xserve08.build.mozilla.org 8.8.4 Darwin Kernel Version 8.8.4: Sun Oct 29 15:26:54 PST 2006; root:xnu-792.16.4.obj~1/RELEASE_I386 i386 i386
#
#- tinder-config.pl - Tinderbox configuration file.
#- Uncomment the variables you need to set.
#- The default values are the same as the commented variables.
$ENV{NO_EM_RESTART} = "1";
$ENV{DYLD_NO_FIX_PREBINDING} = "1";
$ENV{LD_PREBIND_ALLOW_OVERLAP} = "1";
$ENV{CVS_RSH} = "ssh";
$MacUniversalBinary = 1;
# $ENV{MOZ_PACKAGE_MSI}
#-----------------------------------------------------------------------------
# Default: 0
# Values: 0 | 1
# Purpose: Controls whether a MSI package is made.
# Requires: Windows and a local MakeMSI installation.
#$ENV{MOZ_PACKAGE_MSI} = 0;
# $ENV{MOZ_SYMBOLS_TRANSFER_TYPE}
#-----------------------------------------------------------------------------
# Default: scp
# Values: scp | rsync
# Purpose: Use scp or rsync to transfer symbols to the Talkback server.
# Requires: The selected type requires the command be available both locally
# and on the Talkback server.
#$ENV{MOZ_SYMBOLS_TRANSFER_TYPE} = "scp";
#- PLEASE FILL THIS IN WITH YOUR PROPER EMAIL ADDRESS
$BuildAdministrator = 'build@mozilla.org';
#$BuildAdministrator = "$ENV{USER}\@$ENV{HOST}";
#$BuildAdministrator = ($ENV{USER} || "cltbld") . "\@" . ($ENV{HOST} || "dhcp");
#- You'll need to change these to suit your machine's needs
#$DisplayServer = ':0.0';
#- Default values of command-line opts
#-
#$BuildDepend = 1; # Depend or Clobber
#$BuildDebug = 0; # Debug or Opt (Darwin)
#$ReportStatus = 1; # Send results to server, or not
#$ReportFinalStatus = 1; # Finer control over $ReportStatus.
$UseTimeStamp = 0; # Use the CVS 'pull-by-timestamp' option, or not
#$BuildOnce = 0; # Build once, don't send results to server
#$TestOnly = 0; # Only run tests, don't pull/build
#$BuildEmbed = 0; # After building seamonkey, go build embed app.
#$SkipMozilla = 0; # Use to debug post-mozilla.pl scripts.
#$BuildLocales = 0; # Do l10n packaging?
# Tests
$CleanProfile = 1;
#$ResetHomeDirForTests = 1;
$ProductName = 'Firefox';
$VendorName = "Mozilla";
$RunMozillaTests = 1; # Allow turning off of all tests if needed.
$RegxpcomTest = 1;
$AliveTest = 1;
#$JavaTest = 0;
#$ViewerTest = 0;
#$BloatTest = 0; # warren memory bloat test
#$BloatTest2 = 0; # dbaron memory bloat test, require tracemalloc
#$DomToTextConversionTest = 0;
#$XpcomGlueTest = 0;
$CodesizeTest = 0; # Z, require mozilla/tools/codesighs
$EmbedCodesizeTest = 0; # mZ, require mozilla/tools/codesigns
#$MailBloatTest = 0;
#$EmbedTest = 0; # Assumes you wanted $BuildEmbed=1
$LayoutPerformanceTest = 0; # Tp
$LayoutPerformanceLocalTest = 0; # Tp2
$DHTMLPerformanceTest = 0; # Tdhtml
#$QATest = 0;
$XULWindowOpenTest = 0; # Txul
$StartupPerformanceTest = 0; # Ts
$TestsPhoneHome = 0; # Should test report back to server?
$GraphNameOverride = 'xserve08.build.mozilla.org_Fx-Trunk';
# $results_server
#----------------------------------------------------------------------------
# Server on which test results will be accessible. This was originally tegu,
# then became axolotl. Once we moved services from axolotl, it was time
# to give this service its own hostname to make future transitions easier.
# - cmp@mozilla.org
#$results_server = "build-graphs.mozilla.org";
#$pageload_server = "spider"; # localhost
$pageload_server = "pageload.build.mozilla.org"; # localhost
#
# Timeouts, values are in seconds.
#
#$CVSCheckoutTimeout = 3600;
#$CreateProfileTimeout = 45;
#$RegxpcomTestTimeout = 120;
$AliveTestTimeout = 10;
#$ViewerTestTimeout = 45;
#$EmbedTestTimeout = 45;
#$BloatTestTimeout = 120; # seconds
#$MailBloatTestTimeout = 120; # seconds
#$JavaTestTimeout = 45;
#$DomTestTimeout = 45; # seconds
#$XpcomGlueTestTimeout = 15;
#$CodesizeTestTimeout = 900; # seconds
#$CodesizeTestType = "auto"; # {"auto"|"base"}
$LayoutPerformanceTestTimeout = 300; # entire test, seconds
$LayoutPerformanceLocalTestTimeout = 180; # entire test, seconds
$DHTMLPerformanceTestTimeout = 180; # entire test, seconds
#$QATestTimeout = 1200; # entire test, seconds
#$LayoutPerformanceTestPageTimeout = 30000; # each page, ms
#$StartupPerformanceTestTimeout = 15; # seconds
#$XULWindowOpenTestTimeout = 150; # seconds
#$MozConfigFileName = 'mozconfig';
#$UseMozillaProfile = 1;
#$MozProfileName = 'default';
#- Set these to what makes sense for your system
#$Make = 'gmake'; # Must be GNU make
#$MakeOverrides = '';
#$mail = '/bin/mail';
#$CVS = 'cvs -q';
#$CVSCO = 'checkout -P';
# win32 usually doesn't have /bin/mail
#$blat = 'c:/nstools/bin/blat';
#$use_blat = 0;
# Set moz_cvsroot to something like:
# :pserver:$ENV{USER}%netscape.com\@cvs.mozilla.org:/cvsroot
# :pserver:anonymous\@cvs-mirror.mozilla.org:/cvsroot
#
# Note that win32 may not need \@, depends on ' or ".
# :pserver:$ENV{USER}%netscape.com@cvs.mozilla.org:/cvsroot
# CONFIG: $moz_cvsroot = '%mozillaCvsroot%';
$moz_cvsroot = 'cltbld@cvs.mozilla.org:/cvsroot';
#- Set these proper values for your tinderbox server
#$Tinderbox_server = 'tinderbox-daemon@tinderbox.mozilla.org';
# Allow for non-client builds, e.g. camino.
#$moz_client_mk = 'client.mk';
#- Set if you want to build in a separate object tree
$ObjDir = '../build/universal';
# Extra build name, if needed.
$BuildNameExtra = 'Release';
# User comment, eg. ip address for dhcp builds.
# ex: $UserComment = "ip = 208.12.36.108";
#$UserComment = 0;
#-
#- The rest should not need to be changed
#-
#- Minimum wait period from start of build to start of next build in minutes.
#$BuildSleep = 10;
#- Until you get the script working. When it works,
#- change to the tree you're actually building
# CONFIG: $BuildTree = '%buildTree%';
$BuildTree = 'MozillaRelease';
#$BuildName = '';
# CONFIG: $BuildTag = '%productTag%_RELEASE';
$BuildTag = 'FIREFOX_3_0_19_RELEASE';
#$BuildConfigDir = 'mozilla/config';
#$Topsrcdir = 'mozilla';
$BinaryName = 'firefox-bin';
#
# For embedding app, use:
#$EmbedBinaryName = 'TestGtkEmbed';
#$EmbedDistDir = 'dist/bin'
#$ShellOverride = ''; # Only used if the default shell is too stupid
#$ConfigureArgs = '';
#$ConfigureEnvArgs = '';
#$Compiler = 'gcc';
#$NSPRArgs = '';
#$ShellOverride = '';
# Release build options
$ReleaseBuild = 1;
$shiptalkback = 0;
$ReleaseToLatest = 0; # Push the release to latest-<milestone>?
$ReleaseToDated = 1; # Push the release to YYYY-MM-DD-HH-<milestone>?
$build_hour = "4";
$package_creation_path = "/browser/installer";
# needs setting for mac + talkback: $mac_bundle_path = "/browser/app";
$mac_bundle_path = "/browser/app";
$ssh_version = "2";
# CONFIG: $ssh_user = "%sshUser%";
$ssh_user = "cltbld";
# CONFIG: $ssh_server = "%sshServer%";
$ssh_server = "stage-old.mozilla.org";
$ftp_path = "/home/ftp/pub/firefox/nightly";
$url_path = "http://ftp.mozilla.org/pub/mozilla.org/firefox/nightly";
$tbox_ftp_path = "/home/ftp/pub/firefox/tinderbox-builds";
$tbox_url_path = "http://ftp.mozilla.org/pub/mozilla.org/firefox/tinderbox-builds";
# CONFIG: $milestone = 'firefox%version%';
$milestone = 'firefox3.0.19';
$notify_list = "build-announce\@mozilla.org";
$stub_installer = 0;
$sea_installer = 0;
$archive = 1;
$push_raw_xpis = 0;
$update_package = 1;
$update_product = "Firefox";
$update_version = "trunk";
$update_platform = "Darwin_Universal-gcc3";
$update_hash = "sha1";
$update_filehost = "ftp.mozilla.org";
$update_ver_file = 'browser/config/version.txt';
$update_pushinfo = 0;
$crashreporter_buildsymbols = 1;
$crashreporter_pushsymbols = 1;
# CONFIG: $ENV{'SYMBOL_SERVER_HOST'} = '%symbolServer%';
$ENV{'SYMBOL_SERVER_HOST'} = 'dm-symbolpush01.mozilla.org';
# CONFIG: $ENV{'SYMBOL_SERVER_USER'} = '%symbolServerUser%';
$ENV{'SYMBOL_SERVER_USER'} = 'ffxbld';
# CONFIG: $ENV{'SYMBOL_SERVER_PATH'} = '%symbolServerPath%';
$ENV{'SYMBOL_SERVER_PATH'} = '/mnt/netapp/breakpad/symbols_ffx';
# CONFIG: $ENV{'SYMBOL_SERVER_SSH_KEY'} = '%symbolServerKey%';
$ENV{'SYMBOL_SERVER_SSH_KEY'} = '/Users/cltbld/.ssh/ffxbld_dsa';
# Reboot the OS at the end of build-and-test cycle. This is primarily
# intended for Win9x, which can't last more than a few cycles before
# locking up (and testing would be suspect even after a couple of cycles).
# Right now, there is only code to force the reboot for Win9x, so even
# setting this to 1, will not have an effect on other platforms. Setting
# up win9x to automatically logon and begin running tinderbox is left
# as an exercise to the reader.
#$RebootSystem = 0;
# LogCompression specifies the type of compression used on the log file.
# Valid options are 'gzip', and 'bzip2'. Please make sure the binaries
# for 'gzip' or 'bzip2' are in the user's path before setting this
# option.
#$LogCompression = '';
# LogEncoding specifies the encoding format used for the logs. Valid
# options are 'base64', and 'uuencode'. If $LogCompression is set above,
# this needs to be set to 'base64' or 'uuencode' to ensure that the
# binary data is transferred properly.
#$LogEncoding = '';
# Prevent Extension Manager from spawning child processes during tests
# - processes that tbox scripts cannot kill.
#$ENV{NO_EM_RESTART} = '1';
# Do not build XForms
$BuildXForms = 0;

View File

@@ -0,0 +1,22 @@
#
## hostname: fx-win32-tbox
## uname: MINGW32_NT-5.2 FX-WIN32-TBOX 1.0.11(0.46/3/2) 2007-01-12 12:05 i686 Msys
#
export CFLAGS="-GL -wd4624 -wd4952"
export CXXFLAGS="-GL -wd4624 -wd4952"
export LDFLAGS="-LTCG"
mk_add_options MOZ_CO_PROJECT=browser
mk_add_options MOZ_MAKE_FLAGS="-j1"
mk_add_options MOZ_CO_MODULE="mozilla/tools/update-packaging"
mk_add_options PROFILE_GEN_SCRIPT='$(PYTHON) $(MOZ_OBJDIR)/_profile/pgo/profileserver.py'
ac_add_options --enable-application=browser
ac_add_options --enable-update-channel=release
ac_add_options --enable-optimize
ac_add_options --disable-debug
ac_add_options --disable-tests
ac_add_options --enable-update-packaging
ac_add_options --enable-official-branding
ac_add_options --enable-jemalloc
ac_add_options --with-crashreporter-enable-percent=10

View File

@@ -0,0 +1,267 @@
#
## hostname: fx-win32-tbox
## uname: MINGW32_NT-5.2 FX-WIN32-TBOX 1.0.11(0.46/3/2) 2007-01-12 12:05 i686 Msys
#
#- tinder-config.pl - Tinderbox configuration file.
#- Uncomment the variables you need to set.
#- The default values are the same as the commented variables.
$ENV{NO_EM_RESTART} = '1';
$ENV{CVS_RSH} = "ssh";
$ENV{MOZ_CRASHREPORTER_NO_REPORT} = '1';
# Both these two variables are for source server support
$ENV{PDBSTR_PATH} = 'C:\\Program Files\\Debugging Tools for Windows\\sdk\\srcsrv\\pdbstr.exe';
$ENV{SRCSRV_ROOT} = ':pserver:anonymous@cvs-mirror.mozilla.org:/cvsroot';
# $ENV{MOZ_PACKAGE_MSI}
#-----------------------------------------------------------------------------
# Default: 0
# Values: 0 | 1
# Purpose: Controls whether a MSI package is made.
# Requires: Windows and a local MakeMSI installation.
#$ENV{MOZ_PACKAGE_MSI} = 0;
# $ENV{MOZ_SYMBOLS_TRANSFER_TYPE}
#-----------------------------------------------------------------------------
# Default: scp
# Values: scp | rsync
# Purpose: Use scp or rsync to transfer symbols to the Talkback server.
# Requires: The selected type requires the command be available both locally
# and on the Talkback server.
#$ENV{MOZ_SYMBOLS_TRANSFER_TYPE} = "scp";
#- PLEASE FILL THIS IN WITH YOUR PROPER EMAIL ADDRESS
$BuildAdministrator = 'build@mozilla.org';
#$BuildAdministrator = "$ENV{USER}\@$ENV{HOST}";
#$BuildAdministrator = ($ENV{USER} || "cltbld") . "\@" . ($ENV{HOST} || "dhcp");
#- You'll need to change these to suit your machine's needs
#$DisplayServer = ':0.0';
#- Default values of command-line opts
#-
#$BuildDepend = 1; # Depend or Clobber
#$BuildDebug = 0; # Debug or Opt (Darwin)
#$ReportStatus = 1; # Send results to server, or not
#$ReportFinalStatus = 1; # Finer control over $ReportStatus.
$UseTimeStamp = 0; # Use the CVS 'pull-by-timestamp' option, or not
#$BuildOnce = 0; # Build once, don't send results to server
#$TestOnly = 0; # Only run tests, don't pull/build
#$BuildEmbed = 0; # After building seamonkey, go build embed app.
#$SkipMozilla = 0; # Use to debug post-mozilla.pl scripts.
#$BuildLocales = 0; # Do l10n packaging?
# Tests
$CleanProfile = 1;
#$ResetHomeDirForTests = 1;
$ProductName = "Firefox";
$VendorName = "Mozilla";
$RunMozillaTests = 1; # Allow turning off of all tests if needed.
$RegxpcomTest = 1;
$AliveTest = 1;
$JavaTest = 0;
$ViewerTest = 0;
$BloatTest = 0; # warren memory bloat test
$BloatTest2 = 0; # dbaron memory bloat test, require tracemalloc
$DomToTextConversionTest = 0;
$XpcomGlueTest = 0;
$CodesizeTest = 0; # Z, require mozilla/tools/codesighs
$EmbedCodesizeTest = 0; # mZ, require mozilla/tools/codesigns
$MailBloatTest = 0;
$EmbedTest = 0; # Assumes you wanted $BuildEmbed=1
$LayoutPerformanceTest = 0; # Tp
$DHTMLPerformanceTest = 0; # Tdhtml
$QATest = 0;
$XULWindowOpenTest = 0; # Txul
$StartupPerformanceTest = 0; # Ts
$NeckoUnitTest = 0;
$RenderPerformanceTest = 0; # Tgfx
$TestsPhoneHome = 0; # Should test report back to server?
$GraphNameOverride = 'fx-win32-tbox';
# $results_server
#----------------------------------------------------------------------------
# Server on which test results will be accessible. This was originally tegu,
# then became axolotl. Once we moved services from axolotl, it was time
# to give this service its own hostname to make future transitions easier.
# - cmp@mozilla.org
#$results_server = "build-graphs.mozilla.org";
$pageload_server = "pageload.build.mozilla.org"; # localhost
#
# Timeouts, values are in seconds.
#
#$CVSCheckoutTimeout = 3600;
#$CreateProfileTimeout = 45;
#$RegxpcomTestTimeout = 120;
#$AliveTestTimeout = 30;
#$ViewerTestTimeout = 45;
#$EmbedTestTimeout = 45;
#$BloatTestTimeout = 120; # seconds
#$MailBloatTestTimeout = 120; # seconds
#$JavaTestTimeout = 45;
#$DomTestTimeout = 45; # seconds
#$XpcomGlueTestTimeout = 15;
#$CodesizeTestTimeout = 900; # seconds
#$CodesizeTestType = "auto"; # {"auto"|"base"}
$LayoutPerformanceTestTimeout = 800; # entire test, seconds
#$DHTMLPerformanceTestTimeout = 1200; # entire test, seconds
#$QATestTimeout = 1200; # entire test, seconds
#$LayoutPerformanceTestPageTimeout = 30000; # each page, ms
#$StartupPerformanceTestTimeout = 20; # seconds
#$XULWindowOpenTestTimeout = 90; # seconds
#$NeckoUnitTestTimeout = 30; # seconds
$RenderPerformanceTestTimeout = 1800; # seconds
#$MozConfigFileName = 'mozconfig';
#$UseMozillaProfile = 1;
#$MozProfileName = 'default';
#- Set these to what makes sense for your system
$Make = 'make'; # Must be GNU make
#$MakeOverrides = '';
#$mail = '/bin/mail';
#$CVS = 'cvs -q';
#$CVSCO = 'checkout -P';
# win32 usually doesn't have /bin/mail
$blat = '/d/mozilla-build/blat261/full/blat';
#$use_blat = 1;
# Set moz_cvsroot to something like:
# :pserver:$ENV{USER}%netscape.com\@cvs.mozilla.org:/cvsroot
# :pserver:anonymous\@cvs-mirror.mozilla.org:/cvsroot
#
# Note that win32 may not need \@, depends on ' or ".
# :pserver:$ENV{USER}%netscape.com@cvs.mozilla.org:/cvsroot
# CONFIG: $moz_cvsroot = '%mozillaCvsroot%';
$moz_cvsroot = 'cltbld@cvs.mozilla.org:/cvsroot';
#- Set these proper values for your tinderbox server
#$Tinderbox_server = 'tinderbox-daemon@tinderbox.mozilla.org';
# Allow for non-client builds, e.g. camino.
#$moz_client_mk = 'client.mk';
#- Set if you want to build in a separate object tree
$ObjDir = 'obj-fx-trunk';
# Extra build name, if needed.
$BuildNameExtra = 'Release';
# User comment, eg. ip address for dhcp builds.
# ex: $UserComment = "ip = 208.12.36.108";
#$UserComment = 0;
#-
#- The rest should not need to be changed
#-
#- Minimum wait period from start of build to start of next build in minutes.
#$BuildSleep = 10;
#- Until you get the script working. When it works,
#- change to the tree you're actually building
#$BuildTree = 'MozillaTest';
# CONFIG: $BuildTree = '%buildTree%';
$BuildTree = 'MozillaRelease';
#$BuildName = '';
# CONFIG: $BuildTag = '%productTag%_RELEASE';
$BuildTag = 'FIREFOX_3_0_19_RELEASE';
#$BuildConfigDir = 'mozilla/config';
#$Topsrcdir = 'mozilla';
$BinaryName = 'firefox.exe';
#
# For embedding app, use:
#$EmbedBinaryName = 'TestGtkEmbed';
#$EmbedDistDir = 'dist/bin'
#$ShellOverride = ''; # Only used if the default shell is too stupid
#$ConfigureArgs = '';
#$ConfigureEnvArgs = '';
#$Compiler = 'gcc';
#$NSPRArgs = '';
#$ShellOverride = '';
$ProfiledBuild = 1;
# Release build options
$ReleaseBuild = 1;
$shiptalkback = 0;
$ReleaseToLatest = 0; # Push the release to latest-<milestone>?
$ReleaseToDated = 1; # Push the release to YYYY-MM-DD-HH-<milestone>?
$build_hour = "4";
$package_creation_path = "/browser/installer";
# needs setting for mac + talkback: $mac_bundle_path = "/browser/app";
$ssh_version = "2";
# CONFIG: $ssh_user = "%sshUser%";
$ssh_user = "cltbld";
# CONFIG: $ssh_server = "%sshServer%";
$ssh_server = "stage-old.mozilla.org";
$ftp_path = "/home/ftp/pub/firefox/nightly";
$url_path = "http://ftp.mozilla.org/pub/mozilla.org/firefox/nightly";
$tbox_ftp_path = "/home/ftp/pub/firefox/tinderbox-builds";
$tbox_url_path = "http://ftp.mozilla.org/pub/mozilla.org/firefox/tinderbox-builds";
# CONFIG: $milestone = 'firefox%version%';
$milestone = 'firefox3.0.19';
$notify_list = 'build-announce@mozilla.org';
$stub_installer = 0;
$sea_installer = 1;
$archive = 1;
$push_raw_xpis = 0;
$update_package = 1;
$update_product = "Firefox";
$update_version = "trunk";
$update_platform = "WINNT_x86-msvc";
$update_hash = "sha1";
$update_filehost = "ftp.mozilla.org";
$update_ver_file = 'browser/config/version.txt';
$update_pushinfo = 0;
$crashreporter_buildsymbols = 1;
$crashreporter_pushsymbols = 1;
# CONFIG: $ENV{'SYMBOL_SERVER_HOST'} = '%symbolServer%';
$ENV{'SYMBOL_SERVER_HOST'} = 'dm-symbolpush01.mozilla.org';
# CONFIG: $ENV{'SYMBOL_SERVER_USER'} = '%symbolServerUser%';
$ENV{'SYMBOL_SERVER_USER'} = 'ffxbld';
# CONFIG: $ENV{'SYMBOL_SERVER_PATH'} = '%symbolServerPath%';
$ENV{'SYMBOL_SERVER_PATH'} = '/mnt/netapp/breakpad/symbols_ffx';
# CONFIG: $ENV{'SYMBOL_SERVER_SSH_KEY'} = '%symbolServerKey%';
$ENV{'SYMBOL_SERVER_SSH_KEY'} = '/c/Documents and Settings/cltbld/.ssh/ffxbld_dsa';
# Reboot the OS at the end of build-and-test cycle. This is primarily
# intended for Win9x, which can't last more than a few cycles before
# locking up (and testing would be suspect even after a couple of cycles).
# Right now, there is only code to force the reboot for Win9x, so even
# setting this to 1, will not have an effect on other platforms. Setting
# up win9x to automatically logon and begin running tinderbox is left
# as an exercise to the reader.
#$RebootSystem = 0;
# LogCompression specifies the type of compression used on the log file.
# Valid options are 'gzip', and 'bzip2'. Please make sure the binaries
# for 'gzip' or 'bzip2' are in the user's path before setting this
# option.
#$LogCompression = '';
# LogEncoding specifies the encoding format used for the logs. Valid
# options are 'base64', and 'uuencode'. If $LogCompression is set above,
# this needs to be set to 'base64' or 'uuencode' to ensure that the
# binary data is transferred properly.
#$LogEncoding = '';
# Prevent Extension Manager from spawning child processes during tests
# - processes that tbox scripts cannot kill.
#$ENV{NO_EM_RESTART} = '1';
# Do not build XForms
$BuildXForms = 0;

View File

@@ -0,0 +1 @@
Clobbering to force nightly due to nightly bustage from bug 428672.

View File

@@ -0,0 +1,25 @@
#
## hostname: tb-linux-tbox
## uname: Linux tb-linux-tbox.build.mozilla.org 2.6.18-8.el5 #1 SMP Thu Mar 15 19:57:35 EDT 2007 i686 athlon i386 GNU/Linux
#
# symbols for breakpad
export CFLAGS="-gstabs+"
export CXXFLAGS="-gstabs+"
mk_add_options MOZ_CO_PROJECT=mail
mk_add_options MOZ_MAKE_FLAGS=-j1
mk_add_options MOZ_CO_MODULE="mozilla/tools/update-packaging"
ac_add_options --enable-application=mail
ac_add_options --enable-update-channel=beta
ac_add_options --disable-debug
ac_add_options --enable-update-packaging
# Add explicit optimize flags in configure.in, not here - see bug 407794
ac_add_options --enable-optimize
ac_add_options --disable-tests
ac_add_options --disable-shared
ac_add_options --enable-static
CC=/tools/gcc-4.1.1/bin/gcc
CXX=/tools/gcc-4.1.1/bin/g++

View File

@@ -0,0 +1,225 @@
#
## hostname: tb-linux-tbox
## uname: Linux tbnewref-linux-tbox.build.mozilla.org 2.6.18-8.el5 #1 SMP Thu Mar 15 19:57:35 EDT 2007 i686 athlon i386 GNU/Linux
#
#- tinder-config.pl - Tinderbox configuration file.
#- Uncomment the variables you need to set.
#- The default values are the same as the commented variables.
$ENV{CVS_RSH} = "ssh";
$ENV{MOZ_CRASHREPORTER_NO_REPORT} = '1';
#- PLEASE FILL THIS IN WITH YOUR PROPER EMAIL ADDRESS
#$BuildAdministrator = "$ENV{USER}\@$ENV{HOST}";
#$BuildAdministrator = ($ENV{USER} || "cltbld") . "\@" . ($ENV{HOST} || "dhcp");
#- You'll need to change these to suit your machine's needs
#$DisplayServer = ':0.0';
#- Default values of command-line opts
#-
$BuildDepend = 0; # Depend or Clobber
#$BuildDebug = 0; # Debug or Opt (Darwin)
#$ReportStatus = 1; # Send results to server, or not
#$ReportFinalStatus = 1; # Finer control over $ReportStatus.
$UseTimeStamp = 0; # Use the CVS 'pull-by-timestamp' option, or not
#$BuildOnce = 0; # Build once, don't send results to server
#$TestOnly = 0; # Only run tests, don't pull/build
#$BuildEmbed = 0; # After building seamonkey, go build embed app.
#$SkipMozilla = 0; # Use to debug post-mozilla.pl scripts.
# Tests
$CleanProfile = 1;
#$ResetHomeDirForTests = 1;
$ProductName = "Thunderbird";
#$VendorName = "";
$RunMozillaTests = 1; # Allow turning off of all tests if needed.
#$RegxpcomTest = 1;
#$AliveTest = 1;
#$JavaTest = 0;
#$ViewerTest = 0;
#$BloatTest = 0; # warren memory bloat test
#$BloatTest2 = 0; # dbaron memory bloat test, require tracemalloc
#$DomToTextConversionTest = 0;
#$XpcomGlueTest = 0;
$CodesizeTest = 0; # Z, require mozilla/tools/codesighs
#$EmbedCodesizeTest = 0; # mZ, require mozilla/tools/codesigns
#$MailBloatTest = 0;
#$EmbedTest = 0; # Assumes you wanted $BuildEmbed=1
#$LayoutPerformanceTest = 0; # Tp
#$QATest = 0;
#$XULWindowOpenTest = 0; # Txul
#$StartupPerformanceTest = 0; # Ts
$TestsPhoneHome = 0; # Should test report back to server?
#$results_server = "axolotl.mozilla.org"; # was tegu
#$pageload_server = "spider"; # localhost
#
# Timeouts, values are in seconds.
#
#$CVSCheckoutTimeout = 3600;
#$CreateProfileTimeout = 45;
#$RegxpcomTestTimeout = 15;
#$AliveTestTimeout = 45;
#$ViewerTestTimeout = 45;
#$EmbedTestTimeout = 45;
#$BloatTestTimeout = 120; # seconds
#$MailBloatTestTimeout = 120; # seconds
#$JavaTestTimeout = 45;
#$DomTestTimeout = 45; # seconds
#$XpcomGlueTestTimeout = 15;
#$CodesizeTestTimeout = 900; # seconds
#$CodesizeTestType = "auto"; # {"auto"|"base"}
#$LayoutPerformanceTestTimeout = 1200; # entire test, seconds
#$QATestTimeout = 1200; # entire test, seconds
#$LayoutPerformanceTestPageTimeout = 30000; # each page, ms
#$StartupPerformanceTestTimeout = 60; # seconds
#$XULWindowOpenTestTimeout = 150; # seconds
#$MozConfigFileName = 'mozconfig';
#$UseMozillaProfile = 1;
#$MozProfileName = 'default';
#- Set these to what makes sense for your system
#$Make = 'gmake'; # Must be GNU make
#$MakeOverrides = '';
#$mail = '/bin/mail';
#$CVS = 'cvs -q';
#$CVSCO = 'checkout -P';
# win32 usually doesn't have /bin/mail
#$blat = 'c:/nstools/bin/blat';
#$use_blat = 0;
# Set moz_cvsroot to something like:
# :pserver:$ENV{USER}%netscape.com\@cvs.mozilla.org:/cvsroot
# :pserver:anonymous\@cvs-mirror.mozilla.org:/cvsroot
#
# Note that win32 may not need \@, depends on ' or ".
# :pserver:$ENV{USER}%netscape.com@cvs.mozilla.org:/cvsroot
# CONFIG: $moz_cvsroot = '%mozillaCvsroot%';
$moz_cvsroot = 'cltbld@cvs.mozilla.org:/cvsroot';
#- Set these proper values for your tinderbox server
#$Tinderbox_server = 'tinderbox-daemon@tinderbox.mozilla.org';
# Allow for non-client builds, e.g. camino.
#$moz_client_mk = 'client.mk';
#- Set if you want to build in a separate object tree
$ObjDir = 'obj-tb-trunk';
# Extra build name, if needed.
$BuildNameExtra = 'Release';
# User comment, eg. ip address for dhcp builds.
# ex: $UserComment = "ip = 208.12.36.108";
#$UserComment = 0;
#-
#- The rest should not need to be changed
#-
#- Minimum wait period from start of build to start of next build in minutes.
#$BuildSleep = 10;
#- Until you get the script working. When it works,
#- change to the tree you're actually building
# CONFIG: $BuildTree = '%buildTree%';
$BuildTree = 'MozillaRelease';
#$BuildName = '';
# CONFIG: $BuildTag = '%productTag%_RELEASE';
$BuildTag = 'THUNDERBIRD_3_0a2_RELEASE';
#$BuildConfigDir = 'mozilla/config';
#$Topsrcdir = 'mozilla';
$BinaryName = 'thunderbird-bin';
#
# For embedding app, use:
#$EmbedBinaryName = 'TestGtkEmbed';
#$EmbedDistDir = 'dist/bin'
#$ShellOverride = ''; # Only used if the default shell is too stupid
#$ConfigureArgs = '';
#$ConfigureEnvArgs = '';
#$Compiler = 'gcc';
#$NSPRArgs = '';
#$ShellOverride = '';
# allow override of timezone value (for win32 POSIX::strftime)
#$Timezone = '';
# Release build options
$ReleaseBuild = 1;
$ReleaseToLatest = 0; # Push the release to latest-<milestone>?
$ReleaseToDated = 1; # Push the release to YYYY-MM-DD-HH-<milestone>?
$shiptalkback = 0;
$build_hour = "3";
$package_creation_path = "/mail/installer";
$ssh_version = "2";
# CONFIG: $ssh_user = "%sshUser%";
$ssh_user = "cltbld";
# CONFIG: $ssh_server = "%sshServer%";
$ssh_server = "stage-old.mozilla.org";
#$ReleaseGroup = "thunderbird";
$ftp_path = "/home/ftp/pub/thunderbird/nightly";
$url_path = "http://ftp.mozilla.org/pub/mozilla.org/thunderbird/nightly";
$tbox_ftp_path = "/home/ftp/pub/thunderbird/tinderbox-builds";
$tbox_url_path = "http://ftp.mozilla.org/pub/mozilla.org/thunderbird/tinderbox-builds";
# CONFIG: $milestone = 'thunderbird%version%';
$milestone = 'thunderbird3.0a2';
$notify_list = "build-announce\@mozilla.org";
$stub_installer = 0;
$sea_installer = 0;
$archive = 1;
$update_package = 1;
$update_product = "Thunderbird";
$update_version = "trunk";
$update_platform = "Linux_x86-gcc3";
$update_hash = "sha1";
$update_filehost = "ftp.mozilla.org";
$update_ver_file = "mail/config/version.txt";
$update_pushinfo = 0;
$crashreporter_buildsymbols = 1;
$crashreporter_pushsymbols = 1;
# CONFIG: $ENV{'SYMBOL_SERVER_HOST'} = '%symbolServer%';
$ENV{'SYMBOL_SERVER_HOST'} = 'dm-symbolpush01.mozilla.org';
# CONFIG: $ENV{'SYMBOL_SERVER_USER'} = '%symbolServerUser%';
$ENV{'SYMBOL_SERVER_USER'} = 'tbirdbld';
# CONFIG: $ENV{'SYMBOL_SERVER_PATH'} = '%symbolServerPath%';
$ENV{'SYMBOL_SERVER_PATH'} = '/mnt/netapp/breakpad/symbols_tbrd';
# CONFIG: $ENV{'SYMBOL_SERVER_SSH_KEY'} = '%symbolServerKey%';
$ENV{'SYMBOL_SERVER_SSH_KEY'} = '/home/cltbld/.ssh/tbirdbld_dsa';
# Reboot the OS at the end of build-and-test cycle. This is primarily
# intended for Win9x, which can't last more than a few cycles before
# locking up (and testing would be suspect even after a couple of cycles).
# Right now, there is only code to force the reboot for Win9x, so even
# setting this to 1, will not have an effect on other platforms. Setting
# up win9x to automatically logon and begin running tinderbox is left
# as an exercise to the reader.
#$RebootSystem = 0;
# LogCompression specifies the type of compression used on the log file.
# Valid options are 'gzip', and 'bzip2'. Please make sure the binaries
# for 'gzip' or 'bzip2' are in the user's path before setting this
# option.
#$LogCompression = 'bzip2';
# LogEncoding specifies the encoding format used for the logs. Valid
# options are 'base64', and 'uuencode'. If $LogCompression is set above,
# this needs to be set to 'base64' or 'uuencode' to ensure that the
# binary data is transferred properly.
#$LogEncoding = 'base64';

View File

@@ -0,0 +1 @@
Clobbering to force nightly due to nightly bustage from bug 428672.

View File

@@ -0,0 +1,28 @@
#
## hostname: bm-xserve07.build.mozilla.org
## uname: Darwin bm-xserve07.build.mozilla.org 8.8.4 Darwin Kernel Version 8.8.4: Sun Oct 29 15:26:54 PST 2006; root:xnu-792.16.4.obj~1/RELEASE_I386 i386 i386
#
# symbols for breakpad
export CFLAGS="-g -gfull"
export CXXFLAGS="-g -gfull"
. $topsrcdir/build/macosx/universal/mozconfig
# Make flags
mk_add_options MOZ_CO_PROJECT=mail
mk_add_options MOZ_MAKE_FLAGS="-j1"
mk_add_options MOZ_CO_MODULE="mozilla/tools/update-packaging"
mk_add_options MOZ_OBJDIR=@TOPSRCDIR@/../build/universal
# Configure flags
ac_add_options --enable-application=mail
ac_add_options --enable-update-channel=beta
# Add explicit optimize flags in configure.in, not here - see bug 407794
ac_add_options --enable-optimize
ac_add_options --disable-debug
ac_add_options --disable-tests
ac_add_options --enable-static
ac_add_options --disable-shared
ac_add_options --enable-update-packaging

View File

@@ -0,0 +1,262 @@
#
## hostname: bm-xserve07.build.mozilla.org
## uname: Darwin bm-xserve07.build.mozilla.org 8.8.4 Darwin Kernel Version 8.8.4: Sun Oct 29 15:26:54 PST 2006; root:xnu-792.16.4.obj~1/RELEASE_I386 i386 i386
#
#- tinder-config.pl - Tinderbox configuration file.
#- Uncomment the variables you need to set.
#- The default values are the same as the commented variables.
# $ENV{NO_EM_RESTART} = "1";
# $ENV{DYLD_NO_FIX_PREBINDING} = "1";
# $ENV{LD_PREBIND_ALLOW_OVERLAP} = "1";
$ENV{MOZ_CRASHREPORTER_NO_REPORT} = '1';
$MacUniversalBinary = 1;
# $ENV{MOZ_PACKAGE_MSI}
#-----------------------------------------------------------------------------
# Default: 0
# Values: 0 | 1
# Purpose: Controls whether a MSI package is made.
# Requires: Windows and a local MakeMSI installation.
#$ENV{MOZ_PACKAGE_MSI} = 0;
# $ENV{MOZ_SYMBOLS_TRANSFER_TYPE}
#-----------------------------------------------------------------------------
# Default: scp
# Values: scp | rsync
# Purpose: Use scp or rsync to transfer symbols to the Talkback server.
# Requires: The selected type requires the command be available both locally
# and on the Talkback server.
#$ENV{MOZ_SYMBOLS_TRANSFER_TYPE} = "scp";
#- PLEASE FILL THIS IN WITH YOUR PROPER EMAIL ADDRESS
$BuildAdministrator = 'build@mozilla.org';
#$BuildAdministrator = "$ENV{USER}\@$ENV{HOST}";
#$BuildAdministrator = ($ENV{USER} || "cltbld") . "\@" . ($ENV{HOST} || "dhcp");
#- You'll need to change these to suit your machine's needs
#$DisplayServer = ':0.0';
#- Default values of command-line opts
#-
#$BuildDepend = 1; # Depend or Clobber
#$BuildDebug = 0; # Debug or Opt (Darwin)
#$ReportStatus = 1; # Send results to server, or not
#$ReportFinalStatus = 1; # Finer control over $ReportStatus.
$UseTimeStamp = 0; # Use the CVS 'pull-by-timestamp' option, or not
#$BuildOnce = 0; # Build once, don't send results to server
#$TestOnly = 0; # Only run tests, don't pull/build
#$BuildEmbed = 0; # After building seamonkey, go build embed app.
#$SkipMozilla = 0; # Use to debug post-mozilla.pl scripts.
#$BuildLocales = 0; # Do l10n packaging?
# Tests
$CleanProfile = 1;
#$ResetHomeDirForTests = 1;
$ProductName = "Thunderbird";
#$VendorName = 'Mozilla';
$RunMozillaTests = 1; # Allow turning off of all tests if needed.
$RegxpcomTest = 1;
$AliveTest = 1;
#$JavaTest = 0;
#$ViewerTest = 0;
#$BloatTest = 0; # warren memory bloat test
#$BloatTest2 = 0; # dbaron memory bloat test, require tracemalloc
#$DomToTextConversionTest = 0;
#$XpcomGlueTest = 0;
$CodesizeTest = 0; # Z, require mozilla/tools/codesighs
$EmbedCodesizeTest = 0; # mZ, require mozilla/tools/codesigns
#$MailBloatTest = 0;
#$EmbedTest = 0; # Assumes you wanted $BuildEmbed=1
#$LayoutPerformanceTest = 0; # Tp
#$DHTMLPerformanceTest = 0; # Tdhtml
#$QATest = 0;
#$XULWindowOpenTest = 0; # Txul
#$StartupPerformanceTest = 0; # Ts
$TestsPhoneHome = 0; # Should test report back to server?
# $results_server
#----------------------------------------------------------------------------
# Server on which test results will be accessible. This was originally tegu,
# then became axolotl. Once we moved services from axolotl, it was time
# to give this service its own hostname to make future transitions easier.
# - cmp@mozilla.org
#$results_server = "build-graphs.mozilla.org";
#$pageload_server = "spider"; # localhost
#
# Timeouts, values are in seconds.
#
#$CVSCheckoutTimeout = 3600;
#$CreateProfileTimeout = 45;
#$RegxpcomTestTimeout = 120;
#$AliveTestTimeout = 45;
#$ViewerTestTimeout = 45;
#$EmbedTestTimeout = 45;
#$BloatTestTimeout = 120; # seconds
#$MailBloatTestTimeout = 120; # seconds
#$JavaTestTimeout = 45;
#$DomTestTimeout = 45; # seconds
#$XpcomGlueTestTimeout = 15;
#$CodesizeTestTimeout = 900; # seconds
#$CodesizeTestType = "auto"; # {"auto"|"base"}
#$LayoutPerformanceTestTimeout = 1200; # entire test, seconds
#$DHTMLPerformanceTestTimeout = 1200; # entire test, seconds
#$QATestTimeout = 1200; # entire test, seconds
#$LayoutPerformanceTestPageTimeout = 30000; # each page, ms
#$StartupPerformanceTestTimeout = 15; # seconds
#$XULWindowOpenTestTimeout = 150; # seconds
#$MozConfigFileName = 'mozconfig';
#$UseMozillaProfile = 1;
#$MozProfileName = 'default';
#- Set these to what makes sense for your system
#$Make = 'gmake'; # Must be GNU make
#$MakeOverrides = '';
#$mail = '/bin/mail';
#$CVS = 'cvs -q';
#$CVSCO = 'checkout -P';
# win32 usually doesn't have /bin/mail
#$blat = 'c:/nstools/bin/blat';
#$use_blat = 0;
# Set moz_cvsroot to something like:
# :pserver:$ENV{USER}%netscape.com\@cvs.mozilla.org:/cvsroot
# :pserver:anonymous\@cvs-mirror.mozilla.org:/cvsroot
#
# Note that win32 may not need \@, depends on ' or ".
# :pserver:$ENV{USER}%netscape.com@cvs.mozilla.org:/cvsroot
#$moz_cvsroot = $ENV{CVSROOT};
# CONFIG: $moz_cvsroot = '%mozillaCvsroot%';
$moz_cvsroot = 'cltbld@cvs.mozilla.org:/cvsroot';
#- Set these proper values for your tinderbox server
#$Tinderbox_server = 'tinderbox-daemon@tinderbox.mozilla.org';
# Allow for non-client builds, e.g. camino.
#$moz_client_mk = 'client.mk';
#- Set if you want to build in a separate object tree
$ObjDir = '../build/universal';
# Extra build name, if needed.
$BuildNameExtra = 'Release';
# User comment, eg. ip address for dhcp builds.
# ex: $UserComment = "ip = 208.12.36.108";
#$UserComment = 0;
#-
#- The rest should not need to be changed
#-
#- Minimum wait period from start of build to start of next build in minutes.
#$BuildSleep = 10;
#- Until you get the script working. When it works,
#- change to the tree you're actually building
#$BuildTree = 'MozillaTest';
# CONFIG: $BuildTree = '%buildTree%';
$BuildTree = 'MozillaRelease';
#$BuildName = '';
# CONFIG: $BuildTag = '%productTag%_RELEASE';
$BuildTag = 'THUNDERBIRD_3_0a2_RELEASE';
#$BuildConfigDir = 'mozilla/config';
#$Topsrcdir = 'mozilla';
$BinaryName = 'thunderbird-bin';
#
# For embedding app, use:
#$EmbedBinaryName = 'TestGtkEmbed';
#$EmbedDistDir = 'dist/bin'
#$ShellOverride = ''; # Only used if the default shell is too stupid
#$ConfigureArgs = '';
#$ConfigureEnvArgs = '';
#$Compiler = 'gcc';
#$NSPRArgs = '';
#$ShellOverride = '';
# Release build options
$ReleaseBuild = 1;
$shiptalkback = 0;
$ReleaseToLatest = 0; # Push the release to latest-<milestone>?
$ReleaseToDated = 1; # Push the release to YYYY-MM-DD-HH-<milestone>?
$build_hour = "3";
$package_creation_path = "/mail/installer";
# needs setting for mac + talkback: $mac_bundle_path = "/browser/app";
$mac_bundle_path = "/mail/app";
$ssh_version = "2";
# CONFIG: $ssh_user = "%sshUser%";
$ssh_user = "cltbld";
# CONFIG: $ssh_server = "%sshServer%";
$ssh_server = "stage-old.mozilla.org";
#$ReleaseGroup = "thunderbird";
$ftp_path = "/home/ftp/pub/thunderbird/nightly";
$url_path = "http://ftp.mozilla.org/pub/mozilla.org/thunderbird/nightly";
$tbox_ftp_path = "/home/ftp/pub/thunderbird/tinderbox-builds";
$tbox_url_path = "http://ftp.mozilla.org/pub/mozilla.org/thunderbird/tinderbox-builds";
# CONFIG: $milestone = 'thunderbird%version%';
$milestone = 'thunderbird3.0a2';
$notify_list = "build-announce\@mozilla.org";
$stub_installer = 0;
$sea_installer = 0;
$archive = 1;
$push_raw_xpis = 0;
$update_package = 1;
$update_product = "Thunderbird";
$update_version = "trunk";
$update_platform = "Darwin_Universal-gcc3";
$update_hash = "sha1";
$update_filehost = "ftp.mozilla.org";
$update_ver_file = "mail/config/version.txt";
$update_pushinfo = 0;
$crashreporter_buildsymbols = 1;
$crashreporter_pushsymbols = 1;
# CONFIG: $ENV{'SYMBOL_SERVER_HOST'} = '%symbolServer%';
$ENV{'SYMBOL_SERVER_HOST'} = 'dm-symbolpush01.mozilla.org';
# CONFIG: $ENV{'SYMBOL_SERVER_USER'} = '%symbolServerUser%';
$ENV{'SYMBOL_SERVER_USER'} = 'tbirdbld';
# CONFIG: $ENV{'SYMBOL_SERVER_PATH'} = '%symbolServerPath%';
$ENV{'SYMBOL_SERVER_PATH'} = '/mnt/netapp/breakpad/symbols_tbrd';
# CONFIG: $ENV{'SYMBOL_SERVER_SSH_KEY'} = '%symbolServerKey%';
$ENV{'SYMBOL_SERVER_SSH_KEY'} = '/Users/cltbld/.ssh/tbirdbld_dsa';
# Reboot the OS at the end of build-and-test cycle. This is primarily
# intended for Win9x, which can't last more than a few cycles before
# locking up (and testing would be suspect even after a couple of cycles).
# Right now, there is only code to force the reboot for Win9x, so even
# setting this to 1, will not have an effect on other platforms. Setting
# up win9x to automatically logon and begin running tinderbox is left
# as an exercise to the reader.
#$RebootSystem = 0;
# LogCompression specifies the type of compression used on the log file.
# Valid options are 'gzip', and 'bzip2'. Please make sure the binaries
# for 'gzip' or 'bzip2' are in the user's path before setting this
# option.
#$LogCompression = '';
# LogEncoding specifies the encoding format used for the logs. Valid
# options are 'base64', and 'uuencode'. If $LogCompression is set above,
# this needs to be set to 'base64' or 'uuencode' to ensure that the
# binary data is transferred properly.
#$LogEncoding = '';
# Prevent Extension Manager from spawning child processes during tests
# - processes that tbox scripts cannot kill.
#$ENV{NO_EM_RESTART} = '1';

View File

@@ -0,0 +1 @@
Clobbering to force nightly due to nightly bustage from bug 428672.

View File

@@ -0,0 +1,22 @@
#
## hostname: tbnewref-win32-tbox
## MINGW32_NT-5.2 TBNEWREF-WIN32- 1.0.11(0.46/3/2) 2007-01-12 12:05 i686 Msys
#
mk_add_options MOZ_CO_PROJECT=mail
mk_add_options MOZ_DEBUG_SYMBOLS=1
mk_add_options MOZ_MAKE_FLAGS=-j1
mk_add_options MOZ_CO_MODULE="mozilla/tools/update-packaging"
ac_add_options --enable-application=mail
ac_add_options --enable-update-channel=beta
ac_add_options --disable-debug
# Add explicit optimize flags in configure.in, not here - see bug 407794
ac_add_options --enable-optimize
ac_add_options --disable-tests
ac_add_options --disable-shared
ac_add_options --enable-static
ac_add_options --enable-update-packaging
export WIN32_REDIST_DIR="/d/msvs8/VC/redist/x86/Microsoft.VC80.CRT"

View File

@@ -0,0 +1,235 @@
#
## hostname: tbnewref-win32-tbox
## MINGW32_NT-5.2 TBNEWREF-WIN32- 1.0.11(0.46/3/2) 2007-01-12 12:05 i686 Msys
#
#- tinder-config.pl - Tinderbox configuration file.
#- Uncomment the variables you need to set.
#- The default values are the same as the commented variables.
$ENV{CVSROOT}=":ext:tbirdbld\@cvs.mozilla.org:/cvsroot";
$ENV{MOZ_INSTALLER_USE_7ZIP}="1";
$ENV{MOZ_PACKAGE_MSI} = 0;
$ENV{MOZ_CRASHREPORTER_NO_REPORT} = '1';
# Both these two variables are for source server support
$ENV{PDBSTR_PATH} = 'C:\\Program Files\\Debugging Tools for Windows\\sdk\\srcsrv\\pdbstr.exe';
$ENV{SRCSRV_ROOT} = ':pserver:anonymous@cvs-mirror.mozilla.org:/cvsroot';
#- PLEASE FILL THIS IN WITH YOUR PROPER EMAIL ADDRESS
#$BuildAdministrator = "$ENV{USER}\@$ENV{HOST}";
#$BuildAdministrator = ($ENV{USER} || "cltbld") . "\@" . ($ENV{HOST} || "dhcp");
#- You'll need to change these to suit your machine's needs
#$DisplayServer = ':0.0';
#- Default values of command-line opts
#-
$BuildDepend = 0; # Depend or Clobber
#$BuildDebug = 0; # Debug or Opt (Darwin)
#$ReportStatus = 1; # Send results to server, or not
#$ReportFinalStatus = 1; # Finer control over $ReportStatus.
$UseTimeStamp = 0; # Use the CVS 'pull-by-timestamp' option, or not
#$BuildOnce = 0; # Build once, don't send results to server
#$TestOnly = 0; # Only run tests, don't pull/build
#$BuildEmbed = 0; # After building seamonkey, go build embed app.
#$SkipMozilla = 0; # Use to debug post-mozilla.pl scripts.
#$BuildLocales = 0; # Do l10n packaging?
# Tests
$CleanProfile = 1;
#$ResetHomeDirForTests = 1;
$ProductName = "Thunderbird";
#$VendorName = '';
$RunMozillaTests = 1; # Allow turning off of all tests if needed.
#$RegxpcomTest = 1;
#$AliveTest = 1;
#$JavaTest = 0;
#$ViewerTest = 0;
#$BloatTest = 0; # warren memory bloat test
#$BloatTest2 = 0; # dbaron memory bloat test, require tracemalloc
#$DomToTextConversionTest = 0;
#$XpcomGlueTest = 0;
#$CodesizeTest = 0; # Z, require mozilla/tools/codesighs
#$EmbedCodesizeTest = 0; # mZ, require mozilla/tools/codesigns
#$MailBloatTest = 0;
#$EmbedTest = 0; # Assumes you wanted $BuildEmbed=1
#$LayoutPerformanceTest = 0; # Tp
#$DHTMLPerformanceTest = 0; # Tdhtml
#$QATest = 0;
#$XULWindowOpenTest = 0; # Txul
#$StartupPerformanceTest = 0; # Ts
$TestsPhoneHome = 0; # Should test report back to server?
#$results_server = "axolotl.mozilla.org"; # was tegu
#$pageload_server = "spider"; # localhost
#
# Timeouts, values are in seconds.
#
#$CVSCheckoutTimeout = 3600;
#$CreateProfileTimeout = 45;
#$RegxpcomTestTimeout = 120;
#$AliveTestTimeout = 45;
#$ViewerTestTimeout = 45;
#$EmbedTestTimeout = 45;
#$BloatTestTimeout = 120; # seconds
#$MailBloatTestTimeout = 120; # seconds
#$JavaTestTimeout = 45;
#$DomTestTimeout = 45; # seconds
#$XpcomGlueTestTimeout = 15;
#$CodesizeTestTimeout = 900; # seconds
#$CodesizeTestType = "auto"; # {"auto"|"base"}
#$LayoutPerformanceTestTimeout = 1200; # entire test, seconds
#$DHTMLPerformanceTestTimeout = 1200; # entire test, seconds
#$QATestTimeout = 1200; # entire test, seconds
#$LayoutPerformanceTestPageTimeout = 30000; # each page, ms
#$StartupPerformanceTestTimeout = 15; # seconds
#$XULWindowOpenTestTimeout = 150; # seconds
#$MozConfigFileName = 'mozconfig';
#$UseMozillaProfile = 1;
#$MozProfileName = 'default';
#- Set these to what makes sense for your system
$Make = 'make'; # Must be GNU make
#$MakeOverrides = '';
#$mail = '/bin/mail';
#$CVS = 'cvs -q';
#$CVSCO = 'checkout -P';
# win32 usually doesn't have /bin/mail
$blat = '/d/mozilla-build/blat261/full/blat';
$use_blat = 0;
# Set moz_cvsroot to something like:
# :pserver:$ENV{USER}%netscape.com\@cvs.mozilla.org:/cvsroot
# :pserver:anonymous\@cvs-mirror.mozilla.org:/cvsroot
#
# Note that win32 may not need \@, depends on ' or ".
# :pserver:$ENV{USER}%netscape.com@cvs.mozilla.org:/cvsroot
# CONFIG: $moz_cvsroot = '%mozillaCvsroot%';
$moz_cvsroot = 'cltbld@cvs.mozilla.org:/cvsroot';
#- Set these proper values for your tinderbox server
#$Tinderbox_server = 'tinderbox-daemon@tinderbox.mozilla.org';
# Allow for non-client builds, e.g. camino.
#$moz_client_mk = 'client.mk';
#- Set if you want to build in a separate object tree
$ObjDir = 'obj-tb-trunk';
# Extra build name, if needed.
$BuildNameExtra = 'Release';
# User comment, eg. ip address for dhcp builds.
# ex: $UserComment = "ip = 208.12.36.108";
#$UserComment = 0;
#-
#- The rest should not need to be changed
#-
#- Minimum wait period from start of build to start of next build in minutes.
#$BuildSleep = 10;
#- Until you get the script working. When it works,
#- change to the tree you're actually building
# CONFIG: $BuildTree = '%buildTree%';
$BuildTree = 'MozillaRelease';
#$BuildName = '';
# CONFIG: $BuildTag = '%productTag%_RELEASE';
$BuildTag = 'THUNDERBIRD_3_0a2_RELEASE';
#$BuildConfigDir = 'mozilla/config';
#$Topsrcdir = 'mozilla';
$BinaryName = 'thunderbird.exe';
#
# For embedding app, use:
#$EmbedBinaryName = 'TestGtkEmbed';
#$EmbedDistDir = 'dist/bin'
#$ShellOverride = ''; # Only used if the default shell is too stupid
#$ConfigureArgs = '';
#$ConfigureEnvArgs = '';
#$Compiler = 'gcc';
#$NSPRArgs = '';
#$ShellOverride = '';
# Release build options
$ReleaseBuild = 1;
$shiptalkback = 0;
$ReleaseToLatest = 0;
$ReleaseToDated = 1;
$build_hour = "3";
$package_creation_path = "/mail/installer";
# needs setting for mac + talkback: $mac_bundle_path = "/browser/app";
$ssh_version = "2";
# CONFIG: $ssh_user = "%sshUser%";
$ssh_user = "cltbld";
# CONFIG: $ssh_server = "%sshServer%";
$ssh_server = "stage-old.mozilla.org";
#$ReleaseGroup = "thunderbird";
$ftp_path = "/home/ftp/pub/thunderbird/nightly";
$url_path = "http://ftp.mozilla.org/pub/mozilla.org/thunderbird/nightly";
$tbox_ftp_path = "/home/ftp/pub/thunderbird/tinderbox-builds";
$tbox_url_path = "http://ftp.mozilla.org/pub/mozilla.org/thunderbird/tinderbox-builds";
# CONFIG: $milestone = 'thunderbird%version%';
$milestone = 'thunderbird3.0a2';
$notify_list = "build-announce\@mozilla.org";
$stub_installer = 0;
$sea_installer = 1;
$archive = 1;
$push_raw_xpis = 1;
$update_package = 1;
$update_product = "Thunderbird";
$update_version = "trunk";
$update_ver_file = "mail/config/version.txt";
$update_platform = "WINNT_x86-msvc";
$update_hash = "sha1";
$update_filehost = "ftp.mozilla.org";
$update_pushinfo = 0;
$crashreporter_buildsymbols = 1;
$crashreporter_pushsymbols = 1;
# CONFIG: $ENV{'SYMBOL_SERVER_HOST'} = '%symbolServer%';
$ENV{'SYMBOL_SERVER_HOST'} = 'dm-symbolpush01.mozilla.org';
# CONFIG: $ENV{'SYMBOL_SERVER_USER'} = '%symbolServerUser%';
$ENV{'SYMBOL_SERVER_USER'} = 'tbirdbld';
# CONFIG: $ENV{'SYMBOL_SERVER_PATH'} = '%symbolServerPath%';
$ENV{'SYMBOL_SERVER_PATH'} = '/mnt/netapp/breakpad/symbols_tbrd';
# CONFIG: $ENV{'SYMBOL_SERVER_SSH_KEY'} = '%symbolServerKey%';
$ENV{'SYMBOL_SERVER_SSH_KEY'} = '/c/Documents and Settings/cltbld/.ssh/tbirdbld_dsa';
# Reboot the OS at the end of build-and-test cycle. This is primarily
# intended for Win9x, which can't last more than a few cycles before
# locking up (and testing would be suspect even after a couple of cycles).
# Right now, there is only code to force the reboot for Win9x, so even
# setting this to 1, will not have an effect on other platforms. Setting
# up win9x to automatically logon and begin running tinderbox is left
# as an exercise to the reader.
#$RebootSystem = 0;
# LogCompression specifies the type of compression used on the log file.
# Valid options are 'gzip', and 'bzip2'. Please make sure the binaries
# for 'gzip' or 'bzip2' are in the user's path before setting this
# option.
#$LogCompression = '';
# LogEncoding specifies the encoding format used for the logs. Valid
# options are 'base64', and 'uuencode'. If $LogCompression is set above,
# this needs to be set to 'base64' or 'uuencode' to ensure that the
# binary data is transferred properly.
#$LogEncoding = '';
# Prevent Extension Manager from spawning child processes during tests
# - processes that tbox scripts cannot kill.
#$ENV{NO_EM_RESTART} = '1';

View File

@@ -0,0 +1 @@
Clobbering to fix up checkout issues

View File

@@ -0,0 +1,17 @@
#
## hostname: xr-linux-tbox
## uname: Linux xr-linux-tbox.build.mozilla.org 2.6.18-8.el5 #1 SMP Thu Mar 15 19:57:35 EDT 2007 i686 i686 i386 GNU/Linux
#
export MOZILLA_OFFICIAL=1
export JAVA_HOME=/tools/jdk
mk_add_options MOZILLA_OFFICIAL=1
mk_add_options MOZ_CO_PROJECT=xulrunner
mk_add_options MOZ_MAKE_FLAGS="-j3"
ac_add_options --enable-application=xulrunner
ac_add_options --disable-tests
CC=/tools/gcc-4.1.1/bin/gcc
CXX=/tools/gcc-4.1.1/bin/g++

View File

@@ -0,0 +1,262 @@
#
## hostname: xr-linux-tbox
## uname: Linux xr-linux-tbox.build.mozilla.org 2.6.18-8.el5 #1 SMP Thu Mar 15 19:57:35 EDT 2007 i686 i686 i386 GNU/Linux
#
#- tinder-config.pl - Tinderbox configuration file.
#- Uncomment the variables you need to set.
#- The default values are the same as the commented variables.
$ENV{MOZ_CRASHREPORTER_NO_REPORT} = '1';
# $ENV{MOZ_PACKAGE_MSI}
#-----------------------------------------------------------------------------
# Default: 0
# Values: 0 | 1
# Purpose: Controls whether a MSI package is made.
# Requires: Windows and a local MakeMSI installation.
#$ENV{MOZ_PACKAGE_MSI} = 0;
# $ENV{MOZ_SYMBOLS_TRANSFER_TYPE}
#-----------------------------------------------------------------------------
# Default: scp
# Values: scp | rsync
# Purpose: Use scp or rsync to transfer symbols to the Talkback server.
# Requires: The selected type requires the command be available both locally
# and on the Talkback server.
#$ENV{MOZ_SYMBOLS_TRANSFER_TYPE} = "scp";
#- PLEASE FILL THIS IN WITH YOUR PROPER EMAIL ADDRESS
#$BuildAdministrator = "$ENV{USER}\@$ENV{HOST}";
#$BuildAdministrator = ($ENV{USER} || "cltbld") . "\@" . ($ENV{HOST} || "dhcp");
$BuildAdministrator = "build\@mozilla.org";
#- You'll need to change these to suit your machine's needs
#$DisplayServer = ':0.0';
#- Default values of command-line opts
#-
#$BuildDepend = 1; # Depend or Clobber
#$BuildDebug = 0; # Debug or Opt (Darwin)
#$ReportStatus = 1; # Send results to server, or not
#$ReportFinalStatus = 1; # Finer control over $ReportStatus.
$UseTimeStamp = 0; # Use the CVS 'pull-by-timestamp' option, or not
#$BuildOnce = 0; # Build once, don't send results to server
#$ConfigureOnly = 0; # Configure, but do not build.
#$TestOnly = 0; # Only run tests, don't pull/build
#$BuildEmbed = 0; # After building seamonkey, go build embed app.
#$SkipMozilla = 0; # Use to debug post-mozilla.pl scripts.
#$BuildLocales = 0; # Do l10n packaging?
$BuildSDK = 1; # Build the SDK
# Only used when $BuildLocales = 1
%WGetFiles = (); # Pull files from the web, URL => Location
#$WGetTimeout = 360; # Wget timeout, in seconds
#$BuildLocalesArgs = ""; # Extra attributes to add to the makefile command
# which builds the "installers-<locale>" target.
# Typically used to set ZIP_IN and WIN32_INSTALLER_IN
# Tests
$CleanProfile = 1;
#$ResetHomeDirForTests = 1;
$ProductName = "XULRunner";
$VendorName = 'Mozilla';
$RunMozillaTests = 0; # Allow turning off of all tests if needed.
#$RegxpcomTest = 1;
#$AliveTest = 1;
#$JavaTest = 0;
#$ViewerTest = 0;
#$BloatTest = 0; # warren memory bloat test
#$BloatTest2 = 0; # dbaron memory bloat test, require tracemalloc
#$DomToTextConversionTest = 0;
#$XpcomGlueTest = 0;
#$CodesizeTest = 0; # Z, require mozilla/tools/codesighs
#$EmbedCodesizeTest = 0; # mZ, require mozilla/tools/codesigns
#$MailBloatTest = 0;
#$EmbedTest = 0; # Assumes you wanted $BuildEmbed=1
#$LayoutPerformanceTest = 0; # Tp
#$DHTMLPerformanceTest = 0; # Tdhtml
#$QATest = 0;
#$XULWindowOpenTest = 0; # Txul
#$StartupPerformanceTest = 0; # Ts
#@CompareLocaleDirs = (); # Run compare-locales test on these directories
# ("network","dom","toolkit","security/manager");
#$CompareLocalesAviary = 0; # Should the compare-locales commands use the
# aviary directory structure?
#$TestsPhoneHome = 0; # Should test report back to server?
# $results_server
#----------------------------------------------------------------------------
# Server on which test results will be accessible. This was originally tegu,
# then became axolotl. Once we moved services from axolotl, it was time
# to give this service its own hostname to make future transitions easier.
# - cmp@mozilla.org
#$results_server = "build-graphs.mozilla.org";
#$pageload_server = "spider"; # localhost
#
# Timeouts, values are in seconds.
#
#$CVSCheckoutTimeout = 3600;
#$CreateProfileTimeout = 45;
#$RegxpcomTestTimeout = 120;
#$AliveTestTimeout = 45;
#$ViewerTestTimeout = 45;
#$EmbedTestTimeout = 45;
#$BloatTestTimeout = 120; # seconds
#$MailBloatTestTimeout = 120; # seconds
#$JavaTestTimeout = 45;
#$DomTestTimeout = 45; # seconds
#$XpcomGlueTestTimeout = 15;
#$CodesizeTestTimeout = 900; # seconds
#$CodesizeTestType = "auto"; # {"auto"|"base"}
#$LayoutPerformanceTestTimeout = 1200; # entire test, seconds
#$DHTMLPerformanceTestTimeout = 1200; # entire test, seconds
#$QATestTimeout = 1200; # entire test, seconds
#$LayoutPerformanceTestPageTimeout = 30000; # each page, ms
#$StartupPerformanceTestTimeout = 15; # seconds
#$XULWindowOpenTestTimeout = 150; # seconds
#$MozConfigFileName = 'mozconfig';
#$UseMozillaProfile = 1;
#$MozProfileName = 'default';
#- Set these to what makes sense for your system
#$Make = 'gmake'; # Must be GNU make
#$MakeOverrides = '';
#$mail = '/bin/mail';
#$CVS = 'cvs -q';
#$CVSCO = 'checkout -P';
# win32 usually doesn't have /bin/mail
#$blat = 'c:/nstools/bin/blat';
#$use_blat = 0;
# Set moz_cvsroot to something like:
# :pserver:$ENV{USER}%netscape.com\@cvs.mozilla.org:/cvsroot
# :pserver:anonymous\@cvs-mirror.mozilla.org:/cvsroot
#
# Note that win32 may not need \@, depends on ' or ".
# :pserver:$ENV{USER}%netscape.com@cvs.mozilla.org:/cvsroot
#$moz_cvsroot = $ENV{CVSROOT};
# CONFIG: $moz_cvsroot = '%mozillaCvsroot%';
$moz_cvsroot = 'cltbld@cvs.mozilla.org:/cvsroot';
#- Set these proper values for your tinderbox server
#$Tinderbox_server = 'tinderbox-daemon@tinderbox.mozilla.org';
# Allow for non-client builds, e.g. camino.
#$moz_client_mk = 'client.mk';
#- Set if you want to build in a separate object tree
$ObjDir = 'obj-xulrunner';
# Extra build name, if needed.
$BuildNameExtra = 'Release';
# User comment, eg. ip address for dhcp builds.
# ex: $UserComment = "ip = 208.12.36.108";
#$UserComment = 0;
#-
#- The rest should not need to be changed
#-
#- Minimum wait period from start of build to start of next build in minutes.
#$BuildSleep = 10;
#- Until you get the script working. When it works,
#- change to the tree you're actually building
# CONFIG: $BuildTree = '%buildTree%';
$BuildTree = 'MozillaRelease';
#$BuildName = '';
# CONFIG: $BuildTag = '%productTag%_RELEASE';
$BuildTag = 'FIREFOX_3_0_17_RELEASE';
#$BuildConfigDir = 'mozilla/config';
#$Topsrcdir = 'mozilla';
$BinaryName = 'xulrunner-bin';
#
# For embedding app, use:
#$EmbedBinaryName = 'TestGtkEmbed';
#$EmbedDistDir = 'dist/bin'
#$ShellOverride = ''; # Only used if the default shell is too stupid
#$ConfigureArgs = '';
#$ConfigureEnvArgs = '';
#$Compiler = 'gcc';
#$NSPRArgs = '';
#$ShellOverride = '';
# Release build options
$ReleaseBuild = 1;
#$LocaleProduct = "browser";
$shiptalkback = 0;
$ReleaseToLatest = 0; # Push the release to latest-<milestone>?
$ReleaseToDated = 1; # Push the release to YYYY-MM-DD-HH-<milestone>?
#$build_hour = "8";
$package_creation_path = "/xulrunner/installer";
# needs setting for mac + talkback: $mac_bundle_path = "/browser/app";
$ssh_version = "2";
# CONFIG: $ssh_user = "%sshUser%";
$ssh_user = "cltbld";
#$ssh_key = "$ENV{HOME}/.ssh/xrbld_dsa";
# CONFIG: $ssh_server = "%sshServer%";
$ssh_server = "stage-old.mozilla.org";
$ReleaseGroup = "xulrunner";
$ftp_path = "/home/ftp/pub/xulrunner/nightly";
$url_path = "http://ftp.mozilla.org/pub/mozilla.org/xulrunner/nightly";
$tbox_ftp_path = "/home/ftp/pub/xulrunner/tinderbox-builds";
$tbox_url_path = "http://ftp.mozilla.org/pub/mozilla.org/xulrunner/tinderbox-builds";
# CONFIG: $milestone = "xulrunner%version%";
$milestone = "xulrunner1.9.0.17";
$notify_list = "build-announce\@mozilla.org";
$stub_installer = 0;
$sea_installer = 0;
$archive = 1;
$push_raw_xpis = 0;
$crashreporter_buildsymbols = 0;
$crashreporter_pushsymbols = 0;
# CONFIG: $ENV{'SYMBOL_SERVER_HOST'} = '%symbolServer%';
$ENV{'SYMBOL_SERVER_HOST'} = 'stage-old.mozilla.org';
# CONFIG: $ENV{'SYMBOL_SERVER_USER'} = '%symbolServerUser%';
$ENV{'SYMBOL_SERVER_USER'} = 'xrbld';
# CONFIG: $ENV{'SYMBOL_SERVER_PATH'} = '%symbolServerPath%';
$ENV{'SYMBOL_SERVER_PATH'} = '/mnt/netapp/breakpad/symbols_xr';
# CONFIG: $ENV{'SYMBOL_SERVER_SSH_KEY'} = '%symbolServerKey%';
$ENV{'SYMBOL_SERVER_SSH_KEY'} = '/home/cltbld/.ssh/xrbld_dsa';
# Reboot the OS at the end of build-and-test cycle. This is primarily
# intended for Win9x, which can't last more than a few cycles before
# locking up (and testing would be suspect even after a couple of cycles).
# Right now, there is only code to force the reboot for Win9x, so even
# setting this to 1, will not have an effect on other platforms. Setting
# up win9x to automatically logon and begin running tinderbox is left
# as an exercise to the reader.
#$RebootSystem = 0;
# LogCompression specifies the type of compression used on the log file.
# Valid options are 'gzip', and 'bzip2'. Please make sure the binaries
# for 'gzip' or 'bzip2' are in the user's path before setting this
# option.
#$LogCompression = '';
# LogEncoding specifies the encoding format used for the logs. Valid
# options are 'base64', and 'uuencode'. If $LogCompression is set above,
# this needs to be set to 'base64' or 'uuencode' to ensure that the
# binary data is transferred properly.
#$LogEncoding = '';
# Prevent Extension Manager from spawning child processes during tests
# - processes that tbox scripts cannot kill.
#$ENV{NO_EM_RESTART} = '1';

View File

@@ -0,0 +1 @@
CLOBBERing to disable zipwriter from bug 379633

View File

@@ -0,0 +1,20 @@
#
## hostname: bm-xserve09.build.mozilla.org
## uname: Darwin bm-xserve09.build.mozilla.org 8.8.4 Darwin Kernel Version 8.8.4: Sun Oct 29 15:26:54 PST 2006; root:xnu-792.16.4.obj~1/RELEASE_I386 i386 i386
#
. $topsrcdir/build/macosx/universal/mozconfig
export MOZILLA_OFFICIAL=1
export JAVA_HOME=/System/Library/Frameworks/JavaVM.framework/Home
mk_add_options MOZILLA_OFFICIAL=1
mk_add_options MOZ_CO_PROJECT=xulrunner
mk_add_options MOZ_MAKE_FLAGS="-j8"
mk_add_options MOZ_OBJDIR=@TOPSRCDIR@/../build/universal
ac_add_options --enable-application=xulrunner
ac_add_options --disable-tests
ac_add_options --enable-svg
ac_add_options --enable-canvas
ac_add_app_options ppc --enable-prebinding

View File

@@ -0,0 +1,268 @@
#
## hostname: bm-xserve09.build.mozilla.org
## uname: Darwin bm-xserve09.build.mozilla.org 8.8.4 Darwin Kernel Version 8.8.4: Sun Oct 29 15:26:54 PST 2006; root:xnu-792.16.4.obj~1/RELEASE_I386 i386 i386
#
#- tinder-config.pl - Tinderbox configuration file.
#- Uncomment the variables you need to set.
#- The default values are the same as the commented variables.
$MacUniversalBinary = 1;
$ENV{CHOWN_ROOT} = "/builds/tinderbox/bin/chown_root";
$ENV{REVERT_ROOT} = "/builds/tinderbox/bin/revert_root";
$ENV{CHOWN_REVERT} = $ENV{REVERT_ROOT};
$ENV{MOZ_CRASHREPORTER_NO_REPORT} = '1';
# $ENV{MOZ_PACKAGE_MSI}
#-----------------------------------------------------------------------------
# Default: 0
# Values: 0 | 1
# Purpose: Controls whether a MSI package is made.
# Requires: Windows and a local MakeMSI installation.
#$ENV{MOZ_PACKAGE_MSI} = 0;
# $ENV{MOZ_SYMBOLS_TRANSFER_TYPE}
#-----------------------------------------------------------------------------
# Default: scp
# Values: scp | rsync
# Purpose: Use scp or rsync to transfer symbols to the Talkback server.
# Requires: The selected type requires the command be available both locally
# and on the Talkback server.
#$ENV{MOZ_SYMBOLS_TRANSFER_TYPE} = "scp";
#- PLEASE FILL THIS IN WITH YOUR PROPER EMAIL ADDRESS
#$BuildAdministrator = "$ENV{USER}\@$ENV{HOST}";
#$BuildAdministrator = ($ENV{USER} || "cltbld") . "\@" . ($ENV{HOST} || "dhcp");
$BuildAdministrator = "build\@mozilla.org";
#- You'll need to change these to suit your machine's needs
#$DisplayServer = ':0.0';
#- Default values of command-line opts
#-
#$BuildDepend = 1; # Depend or Clobber
#$BuildDebug = 0; # Debug or Opt (Darwin)
#$ReportStatus = 1; # Send results to server, or not
#$ReportFinalStatus = 1; # Finer control over $ReportStatus.
$UseTimeStamp = 0; # Use the CVS 'pull-by-timestamp' option, or not
#$BuildOnce = 0; # Build once, don't send results to server
#$ConfigureOnly = 0; # Configure, but do not build.
#$TestOnly = 0; # Only run tests, don't pull/build
#$BuildEmbed = 0; # After building seamonkey, go build embed app.
#$SkipMozilla = 0; # Use to debug post-mozilla.pl scripts.
#$BuildLocales = 0; # Do l10n packaging?
$BuildSDK = 1; # Build the SDK
# Only used when $BuildLocales = 1
%WGetFiles = (); # Pull files from the web, URL => Location
#$WGetTimeout = 360; # Wget timeout, in seconds
#$BuildLocalesArgs = ""; # Extra attributes to add to the makefile command
# which builds the "installers-<locale>" target.
# Typically used to set ZIP_IN and WIN32_INSTALLER_IN
# Tests
$CleanProfile = 1;
#$ResetHomeDirForTests = 1;
$ProductName = "XULRunner";
$VendorName = 'Mozilla';
$RunMozillaTests = 0; # Allow turning off of all tests if needed.
#$RegxpcomTest = 1;
#$AliveTest = 1;
#$JavaTest = 0;
#$ViewerTest = 0;
#$BloatTest = 0; # warren memory bloat test
#$BloatTest2 = 0; # dbaron memory bloat test, require tracemalloc
#$DomToTextConversionTest = 0;
#$XpcomGlueTest = 0;
#$CodesizeTest = 0; # Z, require mozilla/tools/codesighs
#$EmbedCodesizeTest = 0; # mZ, require mozilla/tools/codesigns
#$MailBloatTest = 0;
#$EmbedTest = 0; # Assumes you wanted $BuildEmbed=1
#$LayoutPerformanceTest = 0; # Tp
#$DHTMLPerformanceTest = 0; # Tdhtml
#$QATest = 0;
#$XULWindowOpenTest = 0; # Txul
#$StartupPerformanceTest = 0; # Ts
#@CompareLocaleDirs = (); # Run compare-locales test on these directories
# ("network","dom","toolkit","security/manager");
#$CompareLocalesAviary = 0; # Should the compare-locales commands use the
# aviary directory structure?
#$TestsPhoneHome = 0; # Should test report back to server?
# $results_server
#----------------------------------------------------------------------------
# Server on which test results will be accessible. This was originally tegu,
# then became axolotl. Once we moved services from axolotl, it was time
# to give this service its own hostname to make future transitions easier.
# - cmp@mozilla.org
#$results_server = "build-graphs.mozilla.org";
#$pageload_server = "spider"; # localhost
#
# Timeouts, values are in seconds.
#
#$CVSCheckoutTimeout = 3600;
#$CreateProfileTimeout = 45;
#$RegxpcomTestTimeout = 120;
#$AliveTestTimeout = 45;
#$ViewerTestTimeout = 45;
#$EmbedTestTimeout = 45;
#$BloatTestTimeout = 120; # seconds
#$MailBloatTestTimeout = 120; # seconds
#$JavaTestTimeout = 45;
#$DomTestTimeout = 45; # seconds
#$XpcomGlueTestTimeout = 15;
#$CodesizeTestTimeout = 900; # seconds
#$CodesizeTestType = "auto"; # {"auto"|"base"}
#$LayoutPerformanceTestTimeout = 1200; # entire test, seconds
#$DHTMLPerformanceTestTimeout = 1200; # entire test, seconds
#$QATestTimeout = 1200; # entire test, seconds
#$LayoutPerformanceTestPageTimeout = 30000; # each page, ms
#$StartupPerformanceTestTimeout = 15; # seconds
#$XULWindowOpenTestTimeout = 150; # seconds
#$MozConfigFileName = 'mozconfig';
#$UseMozillaProfile = 1;
#$MozProfileName = 'default';
#- Set these to what makes sense for your system
#$Make = 'gmake'; # Must be GNU make
#$MakeOverrides = '';
#$mail = '/bin/mail';
#$CVS = 'cvs -q';
#$CVSCO = 'checkout -P';
# win32 usually doesn't have /bin/mail
#$blat = 'c:/nstools/bin/blat';
#$use_blat = 0;
# Set moz_cvsroot to something like:
# :pserver:$ENV{USER}%netscape.com\@cvs.mozilla.org:/cvsroot
# :pserver:anonymous\@cvs-mirror.mozilla.org:/cvsroot
#
# Note that win32 may not need \@, depends on ' or ".
# :pserver:$ENV{USER}%netscape.com@cvs.mozilla.org:/cvsroot
# sharing bm-xserve09 with T'bird build, do all CVS pulls with that key
# CONFIG: $moz_cvsroot = '%mozillaCvsroot%';
$moz_cvsroot = 'cltbld@cvs.mozilla.org:/cvsroot';
#- Set these proper values for your tinderbox server
#$Tinderbox_server = 'tinderbox-daemon@tinderbox.mozilla.org';
# Allow for non-client builds, e.g. camino.
#$moz_client_mk = 'client.mk';
#- Set if you want to build in a separate object tree
$ObjDir = '../build/universal';
# Extra build name, if needed.
$BuildNameExtra = 'Release';
# User comment, eg. ip address for dhcp builds.
# ex: $UserComment = "ip = 208.12.36.108";
#$UserComment = 0;
#-
#- The rest should not need to be changed
#-
#- Minimum wait period from start of build to start of next build in minutes.
#$BuildSleep = 10;
#- Until you get the script working. When it works,
#- change to the tree you're actually building
# CONFIG: $BuildTree = '%buildTree%';
$BuildTree = 'MozillaRelease';
#$BuildName = '';
# CONFIG: $BuildTag = '%productTag%_RELEASE';
$BuildTag = 'FIREFOX_3_0_17_RELEASE';
#$BuildConfigDir = 'mozilla/config';
#$Topsrcdir = 'mozilla';
$BinaryName = 'xulrunner-bin';
#
# For embedding app, use:
#$EmbedBinaryName = 'TestGtkEmbed';
#$EmbedDistDir = 'dist/bin'
#$ShellOverride = ''; # Only used if the default shell is too stupid
#$ConfigureArgs = '';
#$ConfigureEnvArgs = '';
#$Compiler = 'gcc';
#$NSPRArgs = '';
#$ShellOverride = '';
# Release build options
$ReleaseBuild = 1;
#$LocaleProduct = "browser";
$shiptalkback = 0;
$ReleaseToLatest = 0; # Push the release to latest-<milestone>?
$ReleaseToDated = 1; # Push the release to YYYY-MM-DD-HH-<milestone>?
#$build_hour = "8";
$package_creation_path = "/xulrunner/installer";
# needs setting for mac + talkback: $mac_bundle_path = "/browser/app";
$mac_bundle_path = "/browser/app";
$ssh_version = "2";
# CONFIG: $ssh_user = "%sshUser%";
$ssh_user = "cltbld";
#$ssh_key = "$ENV{HOME}/.ssh/xrbld_dsa";
# CONFIG: $ssh_server = "%sshServer%";
$ssh_server = "stage-old.mozilla.org";
$ReleaseGroup = "xulrunner";
$ftp_path = "/home/ftp/pub/xulrunner/nightly";
$url_path = "http://ftp.mozilla.org/pub/mozilla.org/xulrunner/nightly";
$tbox_ftp_path = "/home/ftp/pub/xulrunner/tinderbox-builds";
$tbox_url_path = "http://ftp.mozilla.org/pub/mozilla.org/xulrunner/tinderbox-builds";
# CONFIG: $milestone = 'xulrunner%version%';
$milestone = 'xulrunner1.9.0.17';
$notify_list = "build-announce\@mozilla.org";
$stub_installer = 0;
$sea_installer = 0;
$archive = 1;
$push_raw_xpis = 0;
$crashreporter_buildsymbols = 0;
$crashreporter_pushsymbols = 0;
# CONFIG: $ENV{'SYMBOL_SERVER_HOST'} = '%symbolServer%';
$ENV{'SYMBOL_SERVER_HOST'} = 'stage-old.mozilla.org';
# CONFIG: $ENV{'SYMBOL_SERVER_USER'} = '%symbolServerUser%';
$ENV{'SYMBOL_SERVER_USER'} = 'xrbld';
# CONFIG: $ENV{'SYMBOL_SERVER_PATH'} = '%symbolServerPath%';
$ENV{'SYMBOL_SERVER_PATH'} = '/mnt/netapp/breakpad/symbols_xr';
# CONFIG: $ENV{'SYMBOL_SERVER_SSH_KEY'} = '%symbolServerKey%';
$ENV{'SYMBOL_SERVER_SSH_KEY'} = '/Users/cltbld/.ssh/xrbld_dsa';
# Reboot the OS at the end of build-and-test cycle. This is primarily
# intended for Win9x, which can't last more than a few cycles before
# locking up (and testing would be suspect even after a couple of cycles).
# Right now, there is only code to force the reboot for Win9x, so even
# setting this to 1, will not have an effect on other platforms. Setting
# up win9x to automatically logon and begin running tinderbox is left
# as an exercise to the reader.
#$RebootSystem = 0;
# LogCompression specifies the type of compression used on the log file.
# Valid options are 'gzip', and 'bzip2'. Please make sure the binaries
# for 'gzip' or 'bzip2' are in the user's path before setting this
# option.
#$LogCompression = '';
# LogEncoding specifies the encoding format used for the logs. Valid
# options are 'base64', and 'uuencode'. If $LogCompression is set above,
# this needs to be set to 'base64' or 'uuencode' to ensure that the
# binary data is transferred properly.
#$LogEncoding = '';
# Prevent Extension Manager from spawning child processes during tests
# - processes that tbox scripts cannot kill.
#$ENV{NO_EM_RESTART} = '1';

View File

@@ -0,0 +1 @@
Preemptive clobber for /README.txt merge conflict.

View File

@@ -0,0 +1,18 @@
#
# hostname: fxexp-win32-tbox
# uname: CYGWIN_NT-5.2 fxexp-win32-tbox 1.5.19(0.150/4/2) 2006-01-20 13:28 i686 Cygwin
#
export MOZILLA_OFFICIAL
export JAVA_HOME=/d/jdk1.5.0_10
mk_add_options MOZILLA_OFFICIAL=1
mk_add_options MOZ_CO_PROJECT=xulrunner
mk_add_options MOZ_MAKE_FLAGS="-j2"
ac_add_options --enable-application=xulrunner
ac_add_options --enable-jemalloc
ac_add_options --disable-tests
ac_add_options --enable-svg
ac_add_options --enable-canvas
ac_add_options --disable-installer

View File

@@ -0,0 +1,255 @@
#
# hostname: fxexp-win32-tbox
# uname: CYGWIN_NT-5.2 fxexp-win32-tbox 1.5.19(0.150/4/2) 2006-01-20 13:28 i686 Cygwin
#
#- tinder-config.pl - Tinderbox configuration file.
#- Uncomment the variables you need to set.
#- The default values are the same as the commented variables.
$ENV{NO_EM_RESTART} = "1";
$ENV{MOZ_INSTALLER_USE_7ZIP} = "1";
$ENV{CVS_RSH} = "ssh";
$ENV{MOZ_CRASHREPORTER_NO_REPORT} = '1';
# Both these two variables are for source server support
$ENV{PDBSTR_PATH} = 'C:\\Program Files\\Debugging Tools for Windows\\sdk\\srcsrv\\pdbstr.exe';
$ENV{SRCSRV_ROOT} = ':pserver:anonymous@cvs-mirror.mozilla.org:/cvsroot';
# $ENV{MOZ_PACKAGE_MSI}
#-----------------------------------------------------------------------------
# Default: 0
# Values: 0 | 1
# Purpose: Controls whether a MSI package is made.
# Requires: Windows and a local MakeMSI installation.
#$ENV{MOZ_PACKAGE_MSI} = 0;
# $ENV{MOZ_SYMBOLS_TRANSFER_TYPE}
#-----------------------------------------------------------------------------
# Default: scp
# Values: scp | rsync
# Purpose: Use scp or rsync to transfer symbols to the Talkback server.
# Requires: The selected type requires the command be available both locally
# and on the Talkback server.
#$ENV{MOZ_SYMBOLS_TRANSFER_TYPE} = "scp";
#- PLEASE FILL THIS IN WITH YOUR PROPER EMAIL ADDRESS
#$BuildAdministrator = "$ENV{USER}\@$ENV{HOST}";
#$BuildAdministrator = ($ENV{USER} || "cltbld") . "\@" . ($ENV{HOST} || "dhcp");
$BuildAdministrator = 'build@mozilla.org';
#- You'll need to change these to suit your machine's needs
#$DisplayServer = ':0.0';
#- Default values of command-line opts
#-
#$BuildDepend = 1; # Depend or Clobber
#$BuildDebug = 0; # Debug or Opt (Darwin)
#$ReportStatus = 1; # Send results to server, or not
#$ReportFinalStatus = 1; # Finer control over $ReportStatus.
$UseTimeStamp = 0; # Use the CVS 'pull-by-timestamp' option, or not
#$BuildOnce = 0; # Build once, don't send results to server
#$TestOnly = 0; # Only run tests, don't pull/build
#$BuildEmbed = 0; # After building seamonkey, go build embed app.
#$SkipMozilla = 0; # Use to debug post-mozilla.pl scripts.
#$BuildLocales = 0; # Do l10n packaging?
$BuildSDK = 1; # Build the SDK
# Tests
#$CleanProfile = 0;
#$ResetHomeDirForTests = 1;
$ProductName = "XULRunner";
$VendorName = 'Mozilla';
$RunMozillaTests = 0; # Allow turning off of all tests if needed.
#$RegxpcomTest = 1;
#$AliveTest = 1;
#$JavaTest = 0;
#$ViewerTest = 0;
#$BloatTest = 0; # warren memory bloat test
#$BloatTest2 = 0; # dbaron memory bloat test, require tracemalloc
#$DomToTextConversionTest = 0;
#$XpcomGlueTest = 0;
#$CodesizeTest = 0; # Z, require mozilla/tools/codesighs
#$EmbedCodesizeTest = 0; # mZ, require mozilla/tools/codesigns
#$MailBloatTest = 0;
#$EmbedTest = 0; # Assumes you wanted $BuildEmbed=1
#$LayoutPerformanceTest = 0; # Tp
#$DHTMLPerformanceTest = 0; # Tdhtml
#$QATest = 0;
#$XULWindowOpenTest = 0; # Txul
#$StartupPerformanceTest = 0; # Ts
#$TestsPhoneHome = 0; # Should test report back to server?
# $results_server
#----------------------------------------------------------------------------
# Server on which test results will be accessible. This was originally tegu,
# then became axolotl. Once we moved services from axolotl, it was time
# to give this service its own hostname to make future transitions easier.
# - cmp@mozilla.org
#$results_server = "build-graphs.mozilla.org";
#$pageload_server = "spider"; # localhost
#
# Timeouts, values are in seconds.
#
#$CVSCheckoutTimeout = 3600;
#$CreateProfileTimeout = 45;
#$RegxpcomTestTimeout = 120;
#$AliveTestTimeout = 45;
#$ViewerTestTimeout = 45;
#$EmbedTestTimeout = 45;
#$BloatTestTimeout = 120; # seconds
#$MailBloatTestTimeout = 120; # seconds
#$JavaTestTimeout = 45;
#$DomTestTimeout = 45; # seconds
#$XpcomGlueTestTimeout = 15;
#$CodesizeTestTimeout = 900; # seconds
#$CodesizeTestType = "auto"; # {"auto"|"base"}
#$LayoutPerformanceTestTimeout = 1200; # entire test, seconds
#$DHTMLPerformanceTestTimeout = 1200; # entire test, seconds
#$QATestTimeout = 1200; # entire test, seconds
#$LayoutPerformanceTestPageTimeout = 30000; # each page, ms
#$StartupPerformanceTestTimeout = 15; # seconds
#$XULWindowOpenTestTimeout = 150; # seconds
#$MozConfigFileName = 'mozconfig';
#$UseMozillaProfile = 1;
#$MozProfileName = 'default';
#- Set these to what makes sense for your system
$Make = 'make'; # Must be GNU make
#$MakeOverrides = '';
#$mail = '/bin/mail';
#$CVS = 'cvs -q';
#$CVSCO = 'checkout -P';
# win32 usually doesn't have /bin/mail
$blat = '/d/mozilla-build/blat261/full/blat';
$use_blat = 1;
# Set moz_cvsroot to something like:
# :pserver:$ENV{USER}%netscape.com\@cvs.mozilla.org:/cvsroot
# :pserver:anonymous\@cvs-mirror.mozilla.org:/cvsroot
#
# Note that win32 may not need \@, depends on ' or ".
# :pserver:$ENV{USER}%netscape.com@cvs.mozilla.org:/cvsroot
#$moz_cvsroot = $ENV{CVSROOT};
# CONFIG: $moz_cvsroot = '%mozillaCvsroot%';
$moz_cvsroot = 'cltbld@cvs.mozilla.org:/cvsroot';
#- Set these proper values for your tinderbox server
#$Tinderbox_server = 'tinderbox-daemon@tinderbox.mozilla.org';
# Allow for non-client builds, e.g. camino.
#$moz_client_mk = 'client.mk';
#- Set if you want to build in a separate object tree
$ObjDir = 'obj-xulrunner';
# Extra build name, if needed.
$BuildNameExtra = 'Release';
# User comment, eg. ip address for dhcp builds.
# ex: $UserComment = "ip = 208.12.36.108";
#$UserComment = 0;
#-
#- The rest should not need to be changed
#-
#- Minimum wait period from start of build to start of next build in minutes.
#$BuildSleep = 10;
#- Until you get the script working. When it works,
#- change to the tree you're actually building
# CONFIG: $BuildTree = '%buildTree%';
$BuildTree = 'MozillaRelease';
#$BuildName = '';
# CONFIG: $BuildTag = '%productTag%_RELEASE';
$BuildTag = 'FIREFOX_3_0_17_RELEASE';
#$BuildConfigDir = 'mozilla/config';
#$Topsrcdir = 'mozilla';
$BinaryName = 'xulrunner.exe';
#
# For embedding app, use:
#$EmbedBinaryName = 'TestGtkEmbed';
#$EmbedDistDir = 'dist/bin'
#$ShellOverride = ''; # Only used if the default shell is too stupid
#$ConfigureArgs = '';
#$ConfigureEnvArgs = '';
#$Compiler = 'gcc';
#$NSPRArgs = '';
#$ShellOverride = '';
# Release build options
$ReleaseBuild = 1;
$shiptalkback = 0;
$ReleaseToLatest = 0; # Push the release to latest-<milestone>?
$ReleaseToDated = 1; # Push the release to YYYY-MM-DD-HH-<milestone>?
#$build_hour = "8";
$package_creation_path = "/xulrunner/installer";
# needs setting for mac + talkback: $mac_bundle_path = "/browser/app";
$ssh_version = "2";
# CONFIG: $ssh_user = "%sshUser%";
$ssh_user = "cltbld";
#$ssh_key = "'$ENV{HOME}/.ssh/xrbld_dsa'";
# CONFIG: $ssh_server = "%sshServer%";
$ssh_server = "stage-old.mozilla.org";
$ReleaseGroup = "xulrunner";
$ftp_path = "/home/ftp/pub/xulrunner/nightly";
$url_path = "http://ftp.mozilla.org/pub/mozilla.org/xulrunner/nightly";
$tbox_ftp_path = "/home/ftp/pub/xulrunner/tinderbox-builds";
$tbox_url_path = "http://ftp.mozilla.org/pub/mozilla.org/xulrunner/tinderbox-builds";
# CONFIG: $milestone = 'xulrunner%version%';
$milestone = 'xulrunner1.9.0.17';
$notify_list = 'build-announce@mozilla.org';
$stub_installer = 0;
$sea_installer = 0;
$archive = 1;
$push_raw_xpis = 0;
$crashreporter_buildsymbols = 1;
$crashreporter_pushsymbols = 1;
# CONFIG: $ENV{'SYMBOL_SERVER_HOST'} = '%symbolServer%';
$ENV{'SYMBOL_SERVER_HOST'} = 'stage-old.mozilla.org';
# CONFIG: $ENV{'SYMBOL_SERVER_USER'} = '%symbolServerUser%';
$ENV{'SYMBOL_SERVER_USER'} = 'xrbld';
# CONFIG: $ENV{'SYMBOL_SERVER_PATH'} = '%symbolServerPath%';
$ENV{'SYMBOL_SERVER_PATH'} = '/mnt/netapp/breakpad/symbols_xr';
# CONFIG: $ENV{'SYMBOL_SERVER_SSH_KEY'} = '%symbolServerKey%';
$ENV{'SYMBOL_SERVER_SSH_KEY'} = '/c/Documents and Settings/cltbld/.ssh/xrbld_dsa';
# Reboot the OS at the end of build-and-test cycle. This is primarily
# intended for Win9x, which can't last more than a few cycles before
# locking up (and testing would be suspect even after a couple of cycles).
# Right now, there is only code to force the reboot for Win9x, so even
# setting this to 1, will not have an effect on other platforms. Setting
# up win9x to automatically logon and begin running tinderbox is left
# as an exercise to the reader.
#$RebootSystem = 0;
# LogCompression specifies the type of compression used on the log file.
# Valid options are 'gzip', and 'bzip2'. Please make sure the binaries
# for 'gzip' or 'bzip2' are in the user's path before setting this
# option.
#$LogCompression = '';
# LogEncoding specifies the encoding format used for the logs. Valid
# options are 'base64', and 'uuencode'. If $LogCompression is set above,
# this needs to be set to 'base64' or 'uuencode' to ensure that the
# binary data is transferred properly.
#$LogEncoding = '';
# Prevent Extension Manager from spawning child processes during tests
# - processes that tbox scripts cannot kill.
#$ENV{NO_EM_RESTART} = '1';

View File

@@ -1,743 +0,0 @@
# -*- Mode: perl; tab-width: 4; indent-tabs-mode: nil; -*-
# vim: syntax=perl
################################
# Bugzilla Module #
################################
package BotModules::Bugzilla;
use vars qw(@ISA);
@ISA = qw(BotModules);
use XML::LibXML;
use Fcntl qw(:DEFAULT :flock);
use File::Basename;
# For parsing bugmail.log records. Must be the same as
# FIELD_SEPARATOR in bugmail.pl.
use constant FIELD_SEPARATOR => '::::';
# The log file that we read to report bug changes.
# This will be put in the directory returned by dirname($0).
use constant BUGMAIL_LOG => 'BotModules/.bugmail.log';
1;
# there is a minor error in this module: bugsHistory->$target->$bug is
# accessed even when bugsHistory->$target doesn't yet exist. XXX
# This is ported straight from techbot, so some of the code is a little convoluted. So sue me. I was lazy.
sub Initialise {
my $self = shift;
my $retval = $self->SUPER::Initialise(@_);
my ($throw_away) = $self->GetBugLog();
$throw_away->truncate(0) if $throw_away;
$throw_away->close() if $throw_away;
return $retval;
}
# RegisterConfig - Called when initialised, should call registerVariables
sub RegisterConfig {
my $self = shift;
$self->SUPER::RegisterConfig(@_);
$self->registerVariables(
# [ name, save?, settable? ]
['bugsURI', 1, 1, 'https://bugzilla.mozilla.org/'],
['bugsDWIMQueryDefault', 1, 1, 'short_desc_type=substring&short_desc='],
['bugsDWIMQueryChannelDefault', 1, 1, {}],
['bugsHistory', 0, 0, {}],
['backoffTime', 1, 1, 120],
['ignoreCommentsTo', 1, 1, ['']],
['ignoreCommentsFrom', 1, 1, ['|']],
['mailIgnore', 1, 1, []],
['skipPrefixFor', 1, 1, []],
# The keys for productReportChannels can be in the form of 'Product'
# or 'Product::::Component'. The value is a comma-separated list of
# channel names.
['productReportChannels', 1, 1, {}],
# The fields that you want notifications about.
['reportFields', 1, 1, ['Resolution', 'Flag', 'Attachment Flag',
'NewBug', 'NewAttach']],
# Except in these products, you don't want notifications about
# certain fields (key is product name, value is comma-separated
# list of fields).
['productMuteFields', 1, 1, {}],
# And in these channels, you don't want notifications about certain
# fields (the key is the channel name and the value is a
# comma-separated list of fields).
['channelMuteFields', 1, 1, {}],
# How frequently we check for new bugmail we've received, in seconds.
['updateDelay', 1, 1, 10],
# List of products for which component of new bugs is reported instead
# of only the product. Can also restrict to specific components
# by using Product::::Component syntax and always report components
# by using 'all'.
['reportComponent', 1, 1, ['all']],
['mutes', 1, 1, ''], # "channel channel channel"
# Optionally skip fetching the bug details for automatic notifications
['reportBugDetails', 1, 1, 1]
);
}
sub Help {
my $self = shift;
my ($event) = @_;
my %commands = (
'' => 'The Bugzilla module provides an interface to the bugzilla bug database. It will spot anyone mentioning bugs, too, and report on what they are. For example if someone says \'I think that\'s a dup of bug 5693, the :hover thing\', then this module will display information about bug 5693.',
'bug' => 'Fetches a summary of bugs from bugzilla. Expert syntax: \'bugzilla [bugnumber[,]]*[&bugzillaparameter=value]*\', bug_status: UNCONFIRMED|NEW|ASSIGNED|REOPENED; *type*=substring|; bugtype: include|exclude; order: Assignee|; chfield[from|to|value] short_desc\' long_desc\' status_whiteboard\' bug_file_loc\' keywords\'; \'_type; email[|type][1|2] [reporter|qa_contact|assigned_to|cc]',
'bug-total' => 'Same as bug (which see) but only displays the total line.',
'bugs' => q{A simple DWIM search. Not very clever. ;-)}
. q{ Syntax: '<query string> bugs' e.g. 'mozbot bugs'.},
'ignore' => q{Causes the bot to stop reporting all bug changes}
. q{ made by a particular user in the current channel.}
. q{ Syntax: 'ignore <user@domain.com>' },
'unignore' => q{Causes the bot to un-ignore a previously ignored}
. q{ user. See 'ignore'}
. q{ for more details.},
);
if ($self->isAdmin($event)) {
$commands{'mute'} = 'Disable watching for bug numbers in a channel. Syntax: mute bugzilla in <channel>';
$commands{'unmute'} = 'Enable watching for bug numbers in a channel. Syntax: unmute bugzilla in <channel>';
}
return \%commands;
}
# Schedule - called when bot connects to a server, to install any schedulers
# use $self->schedule($event, $delay, $times, $data)
# where $times is 1 for a single event, -1 for recurring events,
# and a +ve number for an event that occurs that many times.
sub Schedule {
my $self = shift;
my ($event) = @_;
$self->schedule($event, \$self->{'updateDelay'}, -1, 'Bugzilla-BugMail');
return $self->SUPER::Schedule($event);
}
sub Scheduled {
my $self = shift;
my ($event, @data) = @_;
if ($data[0] eq 'Bugzilla-BugMail') {
$self->CheckForBugMail($event);
} else {
return $self->SUPER::Scheduled($event, @data);
}
return 0;
}
sub Told {
my $self = shift;
my ($event, $message) = @_;
if ($message =~ /^\s*ignore (.+)[?!.\s]*$/) {
my $user = $1;
# If we aren't already ignoring them...
if (!grep($_ eq $user, @{$self->{'mailIgnore'}})) {
push (@{$self->{'mailIgnore'}}, $user);
$self->saveConfig();
$self->say($event,
"$event->{'from'}: OK, ignoring changes produced by $user.");
}
else {
$self->say($event,
"$event->{'from'}: $user is already being ignored.");
}
}
elsif ($message =~ /^\s*unignore (.+)[?!.\s]*$/) {
my $user = $1;
my %ignoredUsers = map { $_ => 1 } @{$self->{'mailIgnore'}};
# If we are already ignoring them...
if ($ignoredUsers{$user}) {
delete $ignoredUsers{$user};
$self->{'mailIgnore'} = [keys %ignoredUsers];
$self->saveConfig();
$self->say($event,
"$event->{'from'}: OK, $user is no longer being ignored.");
}
else {
$self->say($event, "$event->{'from'}: $user wasn't being ignored.");
}
}
elsif ($message =~ m/^ \s* # some optional whitespace
(?:please\s+)? # an optional "please", followed optionally by either:
(?: (?:could\s+you\s+)? # 1. an optional "could you",
(?:please\s+)? # another optional "please",
show\s+me\s+ | # and the text "show me"
what\s+is\s+ | # 2. the text "what is"
what\'s\s+ )? # 3. or the text "what's"
bug (?:\s*id)?s? [\#\s]+ # a variant on "bug", "bug id", "bugids", etc
([0-9].*?| # a query string, either a number followed by some optional text, or
&.+?) # a query string, starting with a &.
(?:\s+please)? # followed by yet another optional "please"
[?!.\s]* # ending with some optional punctuation
$/osix) {
my $target = $event->{'target'};
my $bug = $1;
# Single bugs use xml.cgi, because then we get error messages
if ($bug =~ m/^\d+$/) {
$self->FetchBug($event, $bug, 'bug', {'sayAlways' => 1});
} else {
$self->FetchBug($event, $bug, 'bugs', {'sayAlways' => 1});
}
$self->{'bugsHistory'}->{$target}->{$bug} = $event->{'time'} if $bug =~ m/^\d+$/os;
} elsif ($message =~ m/^\s*bug-?total\s+(.+?)\s*$/osi) {
$self->FetchBug($event, $1, 'total');
} elsif ($self->isAdmin($event)) {
if ($message =~ m/^\s*mute\s+bugzilla\s+in\s+(\S+?)\s*$/osi) {
$self->{'mutes'} .= " $1";
$self->saveConfig();
$self->say($event, "$event->{'from'}: Watching for bug numbers disabled in channel $1.");
} elsif ($message =~ m/^\s*unmute\s+bugzilla\s+in\s+(\S+)\s*$/osi) {
my %mutedChannels = map { $_ => 1 } split(/ /o, $self->{'mutes'});
delete($mutedChannels{$1}); # get rid of any mentions of that channel
$self->{'mutes'} = join(' ', keys(%mutedChannels));
$self->saveConfig();
$self->say($event, "$event->{'from'}: Watching for bug numbers reenabled in channel $1.");
} else {
return $self->SUPER::Told(@_);
}
} else {
return $self->SUPER::Told(@_);
}
return 0; # dealt with it...
}
sub CheckForBugs {
my $self = shift;
my ($event, $message) = @_;
if ((($event->{'channel'} eq '') or # either it was /msg'ed, or
($self->{'mutes'} !~ m/^(?:.*\s|)\Q$event->{'channel'}\E(?:|\s.*)$/si)) and # it was sent on a channel in which we aren't muted
(not $self->ignoringCommentsFrom($event->{'from'})) and # we aren't ignoring them
(not $self->ignoringCommentsTo($message))) { # and they aren't talking to someone we need to ignore
my $rest = $message;
my $bugsFound = 0;
my $bugsToFetch = '';
my $bug;
my $skipURI;
do {
if ($rest =~ m/ (?:^| # either the start of the string
[]\s,.;:\\\/=?!()<>{}[-]) # or some punctuation
bug [\s\#]* ([0-9]+) # followed a string similar to "bug # 123" (put the number in $1)
(?:[]\s,.;:\\\/=?!()<>{}[-]+ # followed optionally by some punctuation,
(.*))?$/osix) { # and everything else (which we put in $2)
$bug = $1;
$skipURI = 0;
$rest = $2;
} elsif ($rest =~ m/\Q$self->{'bugsURI'}\Eshow_bug.cgi\?id=([0-9]+)(?:[^0-9&](.*))?$/si) {
$bug = $1;
$skipURI = 1;
$rest = $2;
} else {
$bug = undef;
}
if (defined($bug)) {
$self->debug("Noticed someone mention bug $bug -- investigating...");
$bugsToFetch .= "$bug ";
$bugsFound++;
}
} while (defined($bug));
if ($bugsToFetch ne '') {
$self->FetchBug($event, $bugsToFetch, 'bug', {'skipURI' => $skipURI, 'skipZaroo' =>1});
}
return $bugsFound;
}
return 0;
}
sub Heard {
my $self = shift;
my ($event, $message) = @_;
unless ($self->CheckForBugs($event, $message)) {
return $self->SUPER::Heard(@_);
}
return 0; # we've dealt with it, no need to do anything else.
}
sub Baffled {
my $self = shift;
my ($event, $message) = @_;
if ($message =~ m/^\s*(...+?)\s+bugs\s*$/osi) {
my $target = $event->{'target'};
$self->FetchBug($event, $1, 'dwim');
} else {
return $self->SUPER::Baffled(@_);
}
return 0;
}
sub Felt {
my $self = shift;
my ($event, $message) = @_;
unless ($self->CheckForBugs($event, $message)) {
return $self->SUPER::Felt(@_);
}
return 0; # we've dealt with it, no need to do anything else.
}
sub Saw {
my $self = shift;
my ($event, $message) = @_;
unless ($self->CheckForBugs($event, $message)) {
return $self->SUPER::Saw(@_);
}
return 0; # we've dealt with it, no need to do anything else.
}
sub FetchBug {
my $self = shift;
my ($event, $bugParams, $subtype, $params) = @_;
my $skipURI = exists($params->{'skipURI'}) ? $params->{'skipURI'} : 0;
my $skipZaroo = exists($params->{'skipZaroo'}) ? $params->{'skipZaroo'} : 0;
my $sayAlways = exists($params->{'sayAlways'}) ? $params->{'sayAlways'} : 0;
my $uri;
my $type;
my @bugs = split(' ', $bugParams);
my @ids = ();
foreach my $bug (@bugs) {
if($sayAlways || $self->needToFetchBug($event->{'target'}, $event->{'time'}, $bug)) {
push @ids, $bug;
$self->{'bugsHistory'}->{$event->{'target'}}->{$bug} = $event->{'time'} if $bug =~ m/^\d+$/os;
}
}
return unless @ids;
if ($subtype eq 'bug') {
# Code taken from Bugzilla's xml.cgi
$uri = "$self->{'bugsURI'}show_bug.cgi?ctype=xml&excludefield=long_desc&excludefield=attachmentdata&excludefield=cc".join('', map { $_ = "&id=" . $_ } @ids);
$type = 'xml';
} elsif ($subtype eq 'dwim') {
# XXX should escape query string
my $DWIMdefaultQuery = $self->{'bugsDWIMQueryDefault'};
if (exists $self->{'bugsDWIMQueryChannelDefault'}->{$event->{'channel'}}) {
$DWIMdefaultQuery = $self->{'bugsDWIMQueryChannelDefault'}->{$event->{'channel'}};
}
$uri = "$self->{'bugsURI'}buglist.cgi?format=rdf&$DWIMdefaultQuery".join(',',@ids);
$subtype = 'bugs';
$type = 'buglist';
} else {
$uri = "$self->{'bugsURI'}buglist.cgi?format=rdf&bug_id=".join(',',@ids);
$type = 'buglist';
}
$self->getURI($event, $uri, $type, $subtype, $skipURI, $skipZaroo);
}
sub GotURI {
my $self = shift;
my ($event, $uri, $output, $type, $subtype, $skipURI, $skipZaroo) = @_;
my @bugs;
# Bugzilla really needs a LIMIT option
my $maxRes;
if ($event->{'channel'}) {
$maxRes = 5;
} else {
$maxRes = 20;
}
my $truncated = 0;
if ($type eq 'buglist') {
# We asked for rdf, but old versions won't know how to do that
# So lets do some simple sniffing, until mozbot gives us a way
# to find out the server's returned mime type
my $format;
if ($output =~ /^<\?xml /) {
$type = 'rdf';
} else {
$type = 'html';
}
}
my $lots;
my $bugCount;
if ($type eq 'html') {
my $lots;
my @qp;
# magicness
{ no warnings; # this can go _very_ wrong easily
$lots = ($output !~ m/<FORM\s+METHOD=POST\s+ACTION="long_list.cgi">/osi); # if we got truncated, then this will be missing
# Instead of relying on being able to accurately count the
# number of bugs (which we can't do if there are more than
# 199), use the number that bugzilla tells us.
if ($output =~ /(One|\d+) bugs? found/o) {
$bugCount = $1;
if ($bugCount eq "One") {
$bugCount = 1;
}
}
$output =~ s/<\/TABLE><TABLE .+?<\/A><\/TH>//gosi;
(undef, $output) = split(/Summary<\/A><\/TH>/osi, $output);
($output, undef) = split(/<\/TABLE>/osi, $output);
$output =~ s/[\n\r]//gosi;
@qp = split(m/<TR VALIGN=TOP ALIGN=LEFT CLASS=[-A-Za-z0-9]+(?: style='.*?')?\s*?><TD>/osi, $output);
}
if (scalar(@qp) == 0) {
$bugCount = 0;
}
if (!$lots && $subtype eq 'bugs') {
if (scalar(@qp) > $maxRes) {
$truncated = 1;
@qp = @qp[0..$maxRes-1];
}
foreach (@qp) {
if ($_) {
# more magic
if (my @d = m|<A HREF="show_bug.cgi\?id=([0-9]+)">\1</A> <td class=severity><nobr>(.*?)</nobr><td class=priority><nobr>(.*?)</nobr><td class=platform><nobr>(.*?)</nobr><td class=owner><nobr>(.*?)</nobr><td class=status><nobr>(.*?)</nobr><td class=resolution><nobr>(.*?)</nobr><td class=summary>(.*)|osi) {
# bugid severity priority platform owner status resolution subject
my %bug;
($bug{'id'}, $bug{'severity'}, $bug{'priority'}, $bug{'platform'}, $bug{'owner'}, $bug{'status'}, $bug{'resolution'}, $bug{'summary'}) = @d;
push (@bugs, \%bug);
}
}
}
}
} elsif ($type eq 'xml') {
# We came from xml.cgi
my $parser = XML::LibXML->new();
my $tree = $parser->parse_string($output);
my $root = $tree->getDocumentElement;
my @xml_bugs = $root->getElementsByTagName('bug');
$bugCount = scalar(@xml_bugs);
if (scalar(@xml_bugs) > $maxRes) {
$truncated = 1;
@xml_bugs = @xml_bugs[0..$maxRes-1];
}
# OK, xml.cgi uses different names to the query stuff
# Take a deep breath, and use a mapping for the fields we
# care about
my %fieldMap = (
'bug_id' => 'id',
'bug_severity' => 'severity',
'priority' => 'priority',
'target_milestone' => 'target_milestone',
'assigned_to' => 'owner',
'bug_status' => 'status',
'resolution' => 'resolution',
'short_desc' => 'summary'
);
foreach my $xml_bug(@xml_bugs) {
my %bug = {};
my $error = $xml_bug->getAttribute('error');
if (!defined $error) {
foreach my $field (keys %fieldMap) {
my @arr = $xml_bug->getElementsByTagName($field);
if (@arr) {
my $firstChild = $arr[0]->getFirstChild();
if (defined $firstChild) {
$bug{$fieldMap{$field}} = $firstChild->getData();
}
}
}
}
else {
my @arr = $xml_bug->getElementsByTagName('bug_id');
$bug{'id'} = $arr[0]->getFirstChild->getData();
$bug{'error'} = $error;
}
push @bugs, \%bug;
}
} elsif ($type eq 'rdf') {
my $parser = XML::LibXML->new();
my $tree = $parser->parse_string($output);
my $root = $tree->getDocumentElement;
my @rdf_bugs = $root->getElementsByTagName('bz:bug');
$bugCount = scalar(@rdf_bugs);
if (scalar(@rdf_bugs) > $maxRes) {
$truncated = 1;
@rdf_bugs = @rdf_bugs[0..$maxRes-1];
}
foreach my $rdf_bug (@rdf_bugs) {
my %bug = {};
my @children = $rdf_bug->getChildnodes();
foreach my $child (@children) {
next if ($child->getLocalName() eq 'text');
my $field = $child->getLocalName();
if ($child->getFirstChild()) {
my $val = $child->getFirstChild->getData();
$bug{$field} = $val;
}
}
push @bugs, \%bug;
}
} else {
return $self->SUPER::GotURI(@_);
}
# construct the response's preamble
my $preamble;
if ($bugCount == 0 && !$skipZaroo) {
$preamble = 'Zarro boogs found.';
} else {
my $bugCountStr;
if ($bugCount) {
$bugCountStr = "$bugCount bug" . ($bugCount == 1 ? '' : 's')
. " found";
}
if ($subtype eq 'total') {
$self->say($event, $bugCountStr);
return;
}
if ($lots) {
$preamble = $bugCountStr ? "$bugCountStr, which is too many for me to handle without running out of memory."
: 'Way too many bugs found. I gave up so as to not run out of memory.';
$preamble .= "$bugCountStr Try to narrow your search or something!";
$subtype = 'lots';
} elsif ($subtype ne 'bug' && $bugCount > 1) {
$preamble = $bugCountStr;
if ($truncated) {
if ($event->{'channel'}) {
$preamble .= '. Five shown, please message me for more.';
} else {
$preamble .= '. Will only show 20 results, please use the Bugzilla query form if you want more.';
}
}
}
}
my $prefix;
if ( !$event->{'from'}
|| grep {$_ eq $event->{'from'}} @{$self->{'skipPrefixFor'}} )
{
# they don't want to have the report prefixed with their name
$prefix = '';
} else {
$prefix = "$event->{'from'}: ";
}
if ($preamble) {
$self->say($event, "$prefix$preamble");
}
my $bug_link = $skipURI ? "" : "$self->{'bugsURI'}show_bug.cgi?id=";
# now send out the output
foreach my $bug (@bugs) {
if (!defined $bug->{'error'}) {
# Bugzilla doesn't give the TM by default, and we can't
# change this without using cookies, which aren't supported
# by the mozbot API. Later versions allow us to use a query param
# but we can't detect that that was accepted, which would break
# the HTML parsing
# xml.cgi gives us everything, so we can print this if we got
# results from there
# Maybe the list of columns to display could be a var, one day, after
# installations from source before Dec 2001 are no longer supported,
# or we can pass cookies
$self->say($event, $prefix .
"Bug $bug_link$bug->{'id'} " .
substr($bug->{'severity'} || $bug->{'bug_severity'}, 0, 3) . ", " .
$bug->{'priority'} . ", " .
($bug->{'target_milestone'} ? "$bug->{'target_milestone'}, " : "") .
($bug->{'owner'} || $bug->{'assigned_to'}) . ", " .
substr($bug->{'status'} || $bug->{'bug_status'}, 0, 4) .
($bug->{'resolution'} ? " " . $bug->{'resolution'} : "") . ", " .
substr($bug->{'summary'} || $bug->{'short_desc'} || $bug->{'short_short_desc'}, 0, 100));
} elsif ($bug->{'error'} eq 'NotFound') {
unless($skipZaroo) {
$self->say($event, $prefix . "Bug $bug->{'id'} was not found.");
}
} elsif ($bug->{'error'} eq 'NotPermitted') {
$self->say($event, $prefix . "Bug $bug_link$bug->{'id'} is not accessible");
} else {
unless($skipZaroo) {
$self->say($prefix . "Error accessing bug $bug->{'id'}: $bug->{'error'}");
}
}
}
}
sub CheckForBugMail {
my $self = shift;
my ($event) = @_;
my ($bug_log, $bug_file) = $self->GetBugLog();
my @log_lines;
if (defined $bug_log) {
# We need LOCK_EX because we're going to truncate it.
flock($bug_log, LOCK_EX);
@log_lines = $bug_log->getlines();
$bug_log->truncate(0)
or ($self->debug("Failed to truncate $bug_file: $!") && return);
flock($bug_log, LOCK_UN);
$bug_log->close() or $self->debug("Failed to close $bug_file: $!");
$self->debug("Read " . scalar(@log_lines) . " bugmail log lines.")
if @log_lines;
}
else {
# We will have already output a more detailed error from GetBugLog.
$self->debug("CheckForBugMail Failed: Couldn't read bugmail log.");
return;
}
# Hash to keep track of which channels we've mentioned which bug details
# in, so we don't spew the same bug details over and over.
my %said_bug;
foreach my $line (@log_lines) {
chomp($line);
#$self->debug("Reading log line: $line");
my $sep = FIELD_SEPARATOR;
$line =~ /^(.+)$sep(.+)$sep(.+)$sep(.+)$sep(.+)$sep(.*)$sep(.*)$sep(.+)$/;
my ($bug_id, $product, $component, $who, $field, $old, $new, $message) =
($1, $2, $3, $4, $5, $6, $7, $8);
# Skip this line if we never report anything for this field.
next if !grep($_ eq $field, @{$self->{'reportFields'}});
my @prod_mute_fields =
split(/\s*,\s*/, $self->{'productMuteFields'}->{$product});
my @chan_list;
# Don't report to these channels if this product is muted for this field.
push (@chan_list, $self->CreateChannelList($product, $component))
unless grep($_ eq $field, @prod_mute_fields);
if ($field eq 'Product') {
my @old_mute_fields =
split(/\s*,\s*/, $self->{'productMuteFields'}->{$old});
push(@chan_list, $self->CreateChannelList($old, $component))
unless grep($_ eq $field, @old_mute_fields);
}
elsif ($field eq 'Component') {
my @comp_mute_fields = @prod_mute_fields;
push(@comp_mute_fields,
($self->{'productMuteFields'}->{$product. $sep . $component}));
# Don't report it if the product is muted for this field, or if
# this specific component is muted for this field.
push(@chan_list, $self->CreateChannelList($product, $old))
unless grep($_ eq $field, @comp_mute_fields);
}
# Enable Mozbot to report both product and component of new bugs.
if (grep(lc($_) eq 'all', @{$self->{'reportComponent'}}) ||
grep(lc($_) eq lc($product), @{$self->{'reportComponent'}}) ||
grep(lc($_) eq lc($product.$sep.$component), @{$self->{'reportComponent'}})) {
$message =~ s/^New $product bug/New $product - $component bug/i;
}
unless ($self->ignoringMailProducedBy($who)) {
# Keep track of which channels we've told already, to avoid
# duplicate messages.
my %said_to;
foreach my $channel (@chan_list) {
my @chan_mute_fields =
split(/\s*,\s*/, $self->{'channelMuteFields'}->{$channel});
# Don't say it if we've said it before, or if this
# field is muted in this channel.
unless ( $said_to{$channel}
|| grep($_ eq $field, @chan_mute_fields) )
{
# We can't use "local" here, or the target doesn't show
# up properly in the GotURI after FetchBug.
$event->{'target'} = $channel;
$self->say($event, $message);
my $bugids = "";
# Special case for "duplicate of messages"
if ($message =~ /DUPLICATE of bug (\d+)/) {
my $dup_id = $1;
$bugids = $dup_id unless $said_bug{$channel . $dup_id};
$said_bug{$channel . $dup_id} = 1;
}
# Fetch bugs mentioned for dependent field changes
if ($field eq 'OtherBugsDependingOnThis'
|| $field eq 'BugsThisDependsOn') {
foreach my $id (split(/,/, $old . $new)) {
$bugids = $id . " " . $bugids
unless $said_bug{$channel . $id};
$said_bug{$channel . $id} = 1;
}
}
if (! $said_bug{$channel . $bug_id}) {
$bugids = $bug_id . " " . $bugids;
}
if ($bugids ne '') {
if ($self->{'reportBugDetails'}) {
$self->FetchBug($event, $bugids, 'bug');
}
}
$said_to{$channel} = 1;
$said_bug{$channel . $bug_id} = 1;
} # unless $said_to
} # foreach @chan_list
} # unless ignoringMailProducedBy
} # foreach @log_lines
}
# A helper for CheckForBugMail.
sub CreateChannelList {
my $self = shift;
my ($product, $component) = @_;
my $chan_list = "";
($chan_list .= $self->{'productReportChannels'}->{$product})
if $self->{'productReportChannels'}->{$product};
my $prodcomp = $product . FIELD_SEPARATOR . $component;
($chan_list .= ',' . $self->{'productReportChannels'}->{$prodcomp})
if $self->{'productReportChannels'}->{$prodcomp};
return (split /\s*,\s*/, $chan_list);
}
# Creates the BUGMAIL_LOG file if it doesn't exist, and returns
# an open IO::File for it, and also the filename of that file.
sub GetBugLog {
my $self = shift;
my $file_name = dirname($0) . '/' . BUGMAIL_LOG;
# And we generally trust $bug_log to be an OK path, so untaint it now.
$file_name =~ /^(.*)$/;
$file_name = $1;
my $file = new IO::File($file_name, O_RDWR | O_CREAT, 0660)
or $self->debug("Could not open/create $file_name for reading"
. " incoming bugmail: $!");
return ($file, $file_name);
}
sub ignoringMailProducedBy {
my $self = shift;
my ($who) = @_;
return grep($_ eq $who, @{$self->{'mailIgnore'}}) ? 1 : 0;
}
sub ignoringCommentsTo {
my $self = shift;
my ($who) = @_;
foreach (@{$self->{'ignoreCommentsTo'}}) {
next unless $_; # Ignore blanks, happens when the array is empty (?)
return 1 if $who =~ m/^(?:.*[]\s,.;:\\\/=?!()<>{}[-])?\Q$_\E(?:[]\s,.;:\\\/=?!()<>{}[-].*)?$/is;
}
return 0;
}
sub ignoringCommentsFrom {
my $self = shift;
my ($who) = @_;
foreach (@{$self->{'ignoreCommentsFrom'}}) {
return 1 if $_ eq $who;
}
return 0;
}
sub needToFetchBug {
my ($self, $target, $time, $bug) = @_;
my $last = 0;
if (defined($self->{'bugsHistory'}->{$target}->{$bug})) {
$last = $self->{'bugsHistory'}->{$target}->{$bug};
}
if (($time-$last) > $self->{'backoffTime'}) {
return 1;
}
return 0;
}

View File

@@ -1,530 +0,0 @@
#!/usr/bin/perl -w
#
# The contents of this file are subject to the Mozilla Public
# License Version 1.1 (the "License"); you may not use this file
# except in compliance with the License. You may obtain a copy of
# the License at http://www.mozilla.org/MPL/
#
# Software distributed under the License is distributed on an "AS
# IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
# implied. See the License for the specific language governing
# rights and limitations under the License.
#
# The Original Code is the Mozilla IRC Bot
#
# The Initial Developer of the Original Code is Max Kanat-Alexander.
# Portions developed by Max Kanat-Alexander are Copyright (C) 2005
# Max Kanat-Alexander. All Rights Reserved.
#
# Contributor(s): Max Kanat-Alexander <mkanat@bugzilla.org>
#
# This is loosely based off an older bugmail.pl by justdave.
# bugmail.pl requires that you have X-Bugzilla-Product and
# X-Bugzilla-Component headers in your incoming email. In 2.19.2 and above,
# this is easy. You just add two lines to your newchangedmail param:
# X-Bugzilla-Product: %product%
# X-Bugzilla-Component: %component%
# If you're running 2.18, you can do the same thing, but you need to
# apply the patch from bug 175222 <https://bugzilla.mozilla.org/show_bug.cgi?id=175222>
# to your installation.
use strict;
use Fcntl qw(:flock);
use File::Basename;
use Email::MIME;
#####################################################################
# Constants And Initial Setup
#####################################################################
# What separates Product//Component//[Fields], etc. in a log line.
use constant FIELD_SEPARATOR => '::::';
# These are fields that are multi-select fields, so when somebody
# adds something to them, the verbs "added to " or "removed from" should
# be used instead of the verb "changed" or "set".
# It's a hash, where the names of the fields are the keys, and the values are 1.
# The fields are named as they appear in the "What" part of a bugmail "changes"
# table.
use constant MULTI_FIELDS => {
'CC' => 1, 'Group' => 1, 'Keywords' => 1,
'BugsThisDependsOn' => 1, 'OtherBugsDependingOnThis' => 1,
};
# Some fields have such long names for the "What" column that their names
# wrap. Normally, our code would think that those fields were two different
# fields. So, instead, we store a list of strings to use as an argument
# to "grep" for the field names that we need to "unwrap."
use constant UNWRAP_WHAT => (
qr/^Attachment .\d+$/, qr/^Attachment .\d+ is$/, qr/^OtherBugsDep/,
);
# Should be whatever Bugzilla::Util::find_wrap_point (or FindWrapPoint)
# breaks on, in Bugzilla.
use constant BREAKING_CHARACTERS => (' ',',','-');
# The maximum width, in characters, of each field of the "diffs" table.
use constant WIDTH_WHAT => 19;
use constant WIDTH_REMOVED => 28;
use constant WIDTH_ADDED => 28;
# Our one command-line argument.
our $debug = $ARGV[0] && $ARGV[0] eq "-d";
# XXX - This probably should happen in the log directory instead, but that's
# more difficult to figure out reliably.
my $bug_log = dirname($0) . '/.bugmail.log';
#####################################################################
# Utility Functions
#####################################################################
# When processing the "diffs" table in a bug, some lines wrap. This
# function properly appends the "next" line for unwrapping to an
# existing string.
sub append_diffline ($$$$) {
my ($append_to, $prev_line, $append_line, $max_width) = @_;
my $ret_line = $append_to;
debug_print("Appending Line: [$append_line] Prev Line: [$prev_line]");
debug_print("Prev Line Len: " . length($prev_line)
. " Max Width: $max_width");
# If the previous line is the width of the entire column, we
# assume that we were forcibly wrapped in the middle of a word,
# and no space is needed. We only add the space if we were actually
# given a non-empty string to append.
if ($append_line && length($prev_line) != $max_width) {
debug_print("Adding a space unless we find a breaking character.");
# However, sometimes even if we have a very short line, if it ended
# in a "breaking character" like '-' then we also don't need a space.
$ret_line .= " " unless grep($prev_line =~ /$_$/, BREAKING_CHARACTERS);
}
$ret_line .= $append_line;
debug_print("Appended Line: [$ret_line]");
return $ret_line;
}
# Prints a string if debugging is on. Appends a newline so you don't have to.
sub debug_print ($) {
(print STDERR $_[0] . "\n") if $debug;
}
# Helps with generate_log for Flag messages.
sub flag_action ($$) {
my ($new, $old) = @_;
my $line = "";
my ($flag_name, $action, $requestee) = split_flag($new);
debug_print("Parsing Flag Change: Name: [$flag_name] Action: [$action]")
if $new;
if (!$new) {
$line .= " cancelled $old";
}
elsif ($action eq '+') {
$line .= " granted $flag_name";
}
elsif ($action eq '-') {
$line .= " denied $flag_name";
}
else {
$line .= " requested $flag_name from";
if ($requestee) {
$line .= " " . $requestee;
}
else {
$line .= " the wind";
}
}
return $line;
}
# Takes the $old and $new from a Flag field and returns a hash,
# where the key is the name of the field, and the value is an
# array, where the first item is the old flag string, and the
# new flag string is the second item.
sub parse_flags ($$) {
my ($new, $old) = @_;
my %flags;
foreach my $old_item (split /\s*,\s*/, $old) {
my ($flag_name) = split_flag($old_item);
$flags{$flag_name} = [$old_item, ''];
}
foreach my $new_item (split /\s*,\s*/, $new) {
my ($flag_name) = split_flag($new_item);
if (!exists $flags{$flag_name}) {
$flags{$flag_name} = ['', $new_item];
}
else {
$flags{$flag_name}[1] = $new_item;
}
}
return %flags;
}
# Returns a list: the name of the flag, the action (+/-/?), and
# the requestee (if that exists).
sub split_flag ($) {
my ($flag) = @_;
if ($flag) {
$flag =~ /\s*([^\?]+)(\+|-|\?)(?:\((.*)\))?$/;
return ($1, $2, $3);
}
return ();
}
# Cuts the whitespace off the ends of a string.
# Lovingly borrowed from Bugzilla::Util.
sub trim ($) {
my ($str) = @_;
if ($str) {
$str =~ s/^\s+//g;
$str =~ s/\s+$//g;
}
return $str;
}
#####################################################################
# Main Subroutines
#####################################################################
# Returns a hash, where the keys are the names of fields. The values
# are lists, where the first item is what was removed and the second
# item is what was added.
sub parse_diffs ($) {
my ($body_lines) = @_;
my @body = @$body_lines;
my %changes = ();
my $order = 0;
# Read in the What | Removed | Added table.
# End|of|table will never get run
my @diff_table = grep (/^.*\|.*\|.*$/, @body);
# The first line is the "What|Removed|Added" line, so goes away.
shift(@diff_table);
my ($prev_what, $prev_added, $prev_removed);
# We can't use foreach because we need to modify @diff_table.
while (defined (my $line = shift @diff_table)) {
$line =~ /^(.*)\|(.*)\|(.*)$/;
my ($what, $removed, $added) = (trim($1), trim($2), trim($3));
# These are used to set $prev_removed and $prev_added later.
my ($this_removed, $this_added) = ($removed, $added);
debug_print("---RawLine: $what|$removed|$added\n");
# If we have a field name in the What field.
if ($what) {
$order++;
# If this is a two-line "What" field...
if( grep($what =~ $_, UNWRAP_WHAT) ) {
# Then we need to grab the next line right now.
my $next_line = shift @diff_table;
debug_print("Next Line: $next_line");
$next_line =~ /^(.*)\|(.*)\|(.*)$/;
my ($next_what, $next_removed, $next_added) =
(trim($1), trim($2), trim($3));
debug_print("Two-line What: [$what][$next_what]");
$what = append_diffline($what, $what, $next_what,
WIDTH_WHAT);
if ($next_added) {
debug_print("Two-line Added: [$added][$next_added]");
$added = append_diffline($added, $added,
$next_added, WIDTH_ADDED);
}
if ($next_removed) {
debug_print("Two-line Removed: [$removed][$next_removed]");
$removed = append_diffline($removed, $removed,
$next_removed, WIDTH_REMOVED);
}
}
$changes{$order} = [$what, $removed, $added];
debug_print("Filed as $what: $removed => $added");
# We only set $prev_what if we actually had a $what to put in it.
$prev_what = $what;
}
# Otherwise we're getting data from a previous What.
else {
my $prev_what = $changes{$order}[0];
my $new_removed = append_diffline($changes{$order}[1],
$prev_removed, $removed, WIDTH_REMOVED);
my $new_added = append_diffline($changes{$order}[2],
$prev_added, $added, WIDTH_ADDED);
$changes{$order} = [$prev_what, $new_removed, $new_added];
debug_print("Filed as $prev_what: $removed => $added");
}
($prev_removed, $prev_added) = ($this_removed, $this_added);
}
return %changes;
}
# Takes a reference to an array of lines and returns a hashref
# containing data for a buglog entry.
# Returns undef if the bug should not be entered into the log.
sub parse_mail ($) {
my ($mail_lines) = @_;
my $mail_text = join('', @$mail_lines);
my $email = Email::MIME->new($mail_text);
debug_print("Parsing Message " . $email->header('Message-ID'));
my $body = $email->body;
my @body_lines = split("\n", $body);
my %bug_info;
# Bug ID
my $subject = $email->header('Subject');
if ($subject !~ /^\s*\[Bug (\d+)\] /i) {
debug_print("Not bug: $subject");
return undef;
}
$bug_info{'bug_id'} = $1;
debug_print("Bug $bug_info{bug_id} found.");
# Ignore Dependency mails
# XXX - This should probably be an option in the mozbot instead
if (my ($dep_line) =
grep /bug (\d+), which changed state\.\s*$/, @body_lines)
{
debug_print("Dependency change ignored: $dep_line.");
return undef;
}
# Product
$bug_info{'product'} = $email->header('X-Bugzilla-Product');
unless ($bug_info{'product'}) {
debug_print("X-Bugzilla-Product header not found.");
return undef;
}
debug_print("Product '$bug_info{product}' found.");
# Component
$bug_info{'component'} = $email->header('X-Bugzilla-Component');
unless ($bug_info{'component'}) {
debug_print("X-Bugzilla-Component header not found.");
return undef;
}
debug_print("Component '$bug_info{component}' found.");
# Who
$bug_info{'who'} = $email->header('X-Bugzilla-Who');
# New or Changed
# For Bugzilla vers < 3.0, this code also decides who
if ($subject =~ /^\s*\[Bug \d+\]\s*New: /i) {
$bug_info{'new'} = 1;
debug_print("Bug is New.");
unless ($bug_info{'who'}) {
my ($reporter) = grep /^\s+ReportedBy:\s/, @body_lines;
$reporter =~ s/^\s+ReportedBy:\s//;
$bug_info{'who'} = $reporter;
}
}
elsif (!$bug_info{'who'}) {
if ( my ($changer_line) = grep /^\S+\schanged:$/, @body_lines) {
$changer_line =~ /^(\S+)\s/;
$bug_info{'who'} = $1;
}
elsif ( my ($comment_line) =
grep /^-+.*Comment.*From /i, @body_lines )
{
$comment_line =~ /^-+.*Comment.*From (\S+) /i;
$bug_info{'who'} = $1;
}
}
unless ($bug_info{'who'}) {
debug_print("Could not determine who made the change.");
return undef;
}
debug_print("Who = $bug_info{who}");
# Attachment
my $attachid;
if (($attachid) = grep /^Created an attachment \(id=\d+\)/, @body_lines) {
$attachid =~ /^Created an attachment \(id=(\d+)\)/;
$bug_info{'attach_id'} = $1;
debug_print("attach_id: $bug_info{attach_id}");
}
# Duplicate
my $dupid;
if (($dupid) = grep /marked as a duplicate of (?:bug\s)?\d+/, @body_lines) {
$dupid =~ /marked as a duplicate of (?:bug\s)?(\d+)/;
$bug_info{'dup_of'} = $1;
debug_print("Got dup_of: $bug_info{dup_of}");
}
# Figure out where the diff table ends, and where comments start.
my $comments_start_at = 0;
foreach my $check_line (@body_lines) {
last if $check_line =~ /^-+.*Comment.*From /i;
$comments_start_at++;
}
debug_print("Comments start at line $comments_start_at.");
my @diff_lines = @body_lines[0 .. ($comments_start_at - 1)];
my %diffs = parse_diffs(\@diff_lines);
$bug_info{'diffs'} = \%diffs;
return \%bug_info;
}
# Takes the %bug_info hash returned from parse_mail and
# makes it into one or more lines for the bugmail log.
# BugMail Log Lines have the following format:
# ID::::Product::::Component::::Who::::FieldName::::OldValue::::NewValue::::message
# OldValue and NewValue can be empty.
# FieldName will be 'NewBug' for new bugs, and 'NewAttach' for new attachments.
# Each line ends with a newline, except the last one.
sub generate_log ($) {
my ($bug_info) = @_;
my $prefix = $bug_info->{'bug_id'} . FIELD_SEPARATOR
. $bug_info->{'product'} . FIELD_SEPARATOR
. $bug_info->{'component'} . FIELD_SEPARATOR
. $bug_info->{'who'} . FIELD_SEPARATOR;
my @lines;
# New bugs are easy to handle, so let's handle them first.
if ($bug_info->{'new'}) {
push(@lines, $prefix . 'NewBug' . FIELD_SEPARATOR
# Old and New are empty.
. FIELD_SEPARATOR . FIELD_SEPARATOR
. "New $bug_info->{product} bug $bug_info->{bug_id}"
. " filed by $bug_info->{who}.");
}
if ($bug_info->{'attach_id'}) {
push(@lines, $prefix . 'NewAttach' . FIELD_SEPARATOR
# Old and New are empty.
. FIELD_SEPARATOR . FIELD_SEPARATOR
. "$bug_info->{'who'} added attachment $bug_info->{'attach_id'}"
. " to bug $bug_info->{'bug_id'}.");
}
# And now we handle changes by going over all the diffs, one by one.
my %diffs = %{$bug_info->{'diffs'}};
foreach my $id (sort(keys %diffs)) {
my $field = $diffs{$id}[0];
my $old = $diffs{$id}[1];
my $new = $diffs{$id}[2];
# For attachments, we don't want to include the bug number in
# the output.
$field =~ s/^(Attachment)( .)(\d+)/$1/;
my $attach_id = $3;
# Flags get a *very* special handling.
if ($field =~ /Flag$/) {
my %flags = parse_flags($new, $old);
foreach my $flag (keys %flags) {
my ($old_flag, $new_flag) = @{$flags{$flag}};
my $line = $prefix . $field . FIELD_SEPARATOR
. $old_flag . FIELD_SEPARATOR
. $new_flag . FIELD_SEPARATOR
. $bug_info->{'who'};
$line .= flag_action($new_flag, $old_flag);
if ($field =~ /^Attachment/) {
$line .= " for attachment $attach_id";
}
$line .= " on bug $bug_info->{bug_id}.";
push(@lines, $line);
}
}
# All other, non-Flag fields.
else {
my $line = $prefix . $field . FIELD_SEPARATOR
. $old . FIELD_SEPARATOR . $new . FIELD_SEPARATOR
. $bug_info->{who};
# Some fields require the verbs "added" and "removed", like the
# CC field.
if (MULTI_FIELDS->{$field}) {
($line .= " added $new to") if $new;
($line .= " and") if $new && $old;
($line .= " removed $old from") if $old;
$line .= " the $field field on bug $bug_info->{bug_id}.";
}
# If we didn't remove anything, only added something.
elsif (!$old) {
$line .= " set the $field field on bug"
. " $bug_info->{bug_id} to $new";
# Hack for "RESOLVED DUPLICATE" messages.
$line .= ' of bug ' . $bug_info->{dup_of} if exists $bug_info->{dup_of};
$line .= '.';
}
# If we didn't add anything, only removed something.
elsif (!$new) {
$line .= " cleared the $field '$old' from bug"
. " $bug_info->{bug_id}.";
}
# If we changed a field from one value to another.
else {
$line .= " changed the $field on bug"
. " $bug_info->{bug_id} from $old to $new.";
}
push(@lines, $line);
}
}
debug_print("Generated Log Lines.");
debug_print("Log Line: $_") foreach (@lines);
return join("\n", @lines);
}
# Takes a string and appends it to the buglog.
sub append_log ($) {
my ($string) = @_;
(open FILE, ">>" . $bug_log)
or die "Couldn't open bug log file $bug_log: $!";
debug_print("Waiting for a lock on the log...");
flock(FILE, LOCK_EX);
print FILE $string . "\n";
flock(FILE, LOCK_UN);
debug_print("Printed lines to log and unlocked file.");
close FILE;
}
#####################################################################
# Main Script
#####################################################################
debug_print("\n\n");
unless (-e $bug_log) {
print STDERR "$bug_log does not exist, so I assume that mozbot is not"
. " running. Discarding incoming message.\n";
exit;
}
my @mail_array = <STDIN>;
my $bug_info = parse_mail(\@mail_array);
if (defined $bug_info) {
my $log_lines = generate_log($bug_info);
# If we got an email with just a comment, $log_lines will be empty.
append_log($log_lines) if $log_lines;
}
debug_print("All done!");
exit;

View File

@@ -1,91 +0,0 @@
BugzillaMailHandler.pl is a script that takes in mail from a
Bugzilla installation and possibly reports information about that
mail to specified channels.
Basically, with BugzillaMailHandler.pl, you can use MozBot to inform
you about updates to bugs. For the Bugzilla project, we use this to
inform us whenever a bug is filed, whenever an attachment is added,
and whenever a bug is fixed. We also have it let us know about certain
flags, so that we can go handle those flags quickly.
To use BugzillaMailHandler.pl:
1) Start mozbot, and load the Bugzilla.bm module.
2) Set up your MTA (sendmail, postfix, exim, qmail, etc.) to pipe all
mail coming to a certain address into the script instead of a local
mailbox.
Your MTA must be able to write to files owned by the user that mozbot
is running as. For example, on my local system, my mozbot is run
as a user called "mozbot." I run postfix, so I have postfix become
the "mozbot" user before running BugzillaMailHandler.pl.
3) Now, all bugmail coming in to BugzillaMailHandler will start producing
input in BotModules/.bugmail.log (a hidden file). Mail that isn't in
the standard Bugzilla format will be discarded. Mails that just have
comments, or just inform that a dependency has been RESOLVED will be
ignored.
4) Now, you need to tell your bot to start reporting certain Bugzilla
Products to certain channels. In the future, there will be a command
for this, but for now you have to do it manually. There is a variable
in the Bugzilla module called "productReportChannels." It's a hash --
the keys are names of products, and the values are comma-separated
lists of channels.
5) Once you set that variable, your mozbot will start reporting changes
to the specified products, in the specified channels.
However, it won't report *all* changes -- it will only report the
changes to fields that are specified in the "reportFields" variable,
which is a list of fields. Most fields have the *name that they would
have in a Bugzilla email*, in the "What" column of the table where
the mail shows bug changes.
There are some special fields:
Attachment Flag - Any attachment flag change.
NewBug - When a new bug is filed.
NewAttach - When a new attachment is posted to a bug.
Now, your mozbot should be up and running and reporting the changes
that you want!
Other Notes
-----------
There are a few other features that you can use to fine-tune how MozBot
reports bug changes. First, anybody (not just a bot admin) can tell the
bot to temporarily stop reporting changes from a certain Bugzilla user:
ignore user@domain.com
And to turn back on notifications about that user:
unignore user@domain.com
There are also some variables you can use to configure how mozbot reports
changes, and what changes he reports:
channelMuteFields - A hash, where the key is the name of a channel, and
the value is a comma-separated list of Fields, just
like they would show up in the reportFields var.
Changes to these fields will *not* be reported in
the specified channels, but will still be reported
in the other channels mozbot is configured to announce
things to.
productMuteFields - A hash, where the key is the name of a Product in
Bugzilla, and the value is a comma-separated list
of Fields, just like they would show up in the
reportFields var.
Changes to the specified Fields on the specified
products will not be reported to any channel, ever.
updateDelay - How often mozbot checks for information in the
.bugmail.log file. Usually you can keep this at the
default, unless you want to increase it for some reason.
Questions about this functionality can be asked in #mozwebtools on
irc.mozilla.org.

View File

@@ -1,27 +0,0 @@
Unless otherwise stated, the contents of these file are subject to
the Mozilla Public License Version 1.1 (the "License"); you may
not use this file except in compliance with the License. You may
obtain a copy of the License at http://www.mozilla.org/MPL/
Software distributed under the License is distributed on an "AS
IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
implied. See the License for the specific language governing
rights and limitations under the License.
The Original Code is the Bugzilla Bug Tracking System.
The Initial Developer of the Original Code is Netscape
Communications Corporation. Portions created by Netscape are
Copyright (C) 1998 Netscape Communications Corporation. All Rights
Reserved.
Contributor(s): Harrison Page <harrison@netscape.com>
Terry Weissman <terry@mozilla.org>
Risto Kotalampi <risto@kotalampi.com>
Josh Soref <timeless@mac.com>
Ian Hickson <mozbot@hixie.ch>
Zach Lipton <zach@zachlipton.com>
Jake Steenhagen <jake@acutex.net>
mental <xor@ivwnet.com>
Mohamed Elzakzoki <mhtawfiq@yifan.net>
Jeff Bisbee <mozilla-bugs@jbisbee.com>

View File

@@ -1,630 +0,0 @@
# -*- Mode: perl; tab-width: 4; indent-tabs-mode: nil; -*-
################################
# Converter Module #
################################
# Originally by GluffiS <gluffis@mean.net>
package BotModules::Converter;
use vars qw(@ISA);
@ISA = qw(BotModules);
1;
# XXX support the suffixes "to <n> sf" or "to <n> dp"
# XXX support speed, volume, twips
# XXX support light year, parsec, furlong; fm, pm, µm, Mm, Gm, Tm, Pm
# XXX support 1x10^1 notation as well as the already-supported 1e1 notation
sub Help {
my $self = shift;
my ($event) = @_;
return {
'' => 'A generic converter. Currently supports converting between positive integers in binary, octal, decimal and hexidecimal forms, and converting temperatures, lengths, times and masses.',
'syntax' => 'To convert a number, simply give the number with units or appropriate prefixes, for example to convert from hexadecimal: \'0x2F\'',
'integers' => 'Decimal: Simply give the number. Hexadecimal: Prefix with 0x. Octal: Prefix with 0. Binary: Prefix with 0b.',
'temperature' => 'Kelvin: Suffix with K. Celsius: Suffix with C. Fahrenheit: Suffix with F.',
'length' => 'Imperial: in, ft, yd, mi. Metric: A, nm, mm, cm, m, km.', # XXX should also support light year, parsec, furlong; fm, pm, µm, Mm, Gm, Tm, Pm
'time' => 'ISO time units: year, month, week, day, hour, minute, second. Exotic time units: millifortnight.',
'mass' => 'Imperial: lbs, oz, stone. Metric: kg, g.',
# XXX should support speed, volume, twips
};
}
sub Told {
my $self = shift;
my ($event, $message) = @_;
# integers
if ($message =~ m/^\s*([1-9][0-9]*|0)\s*\??\s*$/osi) {
$self->convertDecimal($event, $1);
} elsif ($message =~ m/^\s*0x([a-f0-9]+)\s*\??\s*$/osi) {
$self->convertHex($event, $1);
} elsif ($message =~ m/^\s*0([0-9]+)\s*\??\s*$/osi) {
$self->convertOctal($event, $1);
} elsif ($message =~ m/^\s*0b([0-9]+)\s*\??\s*$/osi) {
$self->convertBinary($event, $1);
# temperatures
} elsif ($message =~ m/^\s*(-?(?:[0-9]+\.?|[0-9]+\.[0-9]+|\.[0-9]+)(?:e-?[0-9]+)?)\s*(?:kelvin|K)\s*\??\s*$/osi) {
$self->convertKelvin($event, $1);
} elsif ($message =~ m/^\s*(-?(?:[0-9]+\.?|[0-9]+\.[0-9]+|\.[0-9]+)(?:e-?[0-9]+)?)\s*(?:deg(?:rees?)|[\`°])?\s*(?:cel[sc]ius|centigrade|c)\s*\??\s*$/osi) {
$self->convertCelsius($event, $1);
} elsif ($message =~ m/^\s*(-?(?:[0-9]+\.?|[0-9]+\.[0-9]+|\.[0-9]+)(?:e-?[0-9]+)?)\s*(?:deg(?:rees?)|[\`°])?\s*(?:fahrenheit|f)\s*\??\s*$/osi) {
$self->convertFahrenheit($event, $1);
# imperial lengths
} elsif ($message =~ m/^\s*(-?(?:[0-9]+\.?|[0-9]+\.[0-9]+|\.[0-9]+)(?:e-?[0-9]+)?)\s*(?:ins?|inch(?:es)?)\s*\??\s*$/osi) {
$self->convertInches($event, $1);
} elsif ($message =~ m/^\s*(-?(?:[0-9]+\.?|[0-9]+\.[0-9]+|\.[0-9]+)(?:e-?[0-9]+)?)\s*(?:ft|feet|foot)\s*\??\s*$/osi) {
$self->convertFeet($event, $1);
} elsif ($message =~ m/^\s*(-?(?:[0-9]+\.?|[0-9]+\.[0-9]+|\.[0-9]+)(?:e-?[0-9]+)?)\s*(?:yds?|yards?)\s*\??\s*$/osi) {
$self->convertYards($event, $1);
} elsif ($message =~ m/^\s*(-?(?:[0-9]+\.?|[0-9]+\.[0-9]+|\.[0-9]+)(?:e-?[0-9]+)?)\s*(?:mi|miles?)\s*\??\s*$/osi) {
$self->convertMiles($event, $1);
# metric lengths
} elsif ($message =~ m/^\s*(-?(?:[0-9]+\.?|[0-9]+\.[0-9]+|\.[0-9]+)(?:e-?[0-9]+)?)\s*(?:Å|a|angstroms?)\s*\??\s*$/osi) {
$self->convertAngstroms($event, $1);
} elsif ($message =~ m/^\s*(-?(?:[0-9]+\.?|[0-9]+\.[0-9]+|\.[0-9]+)(?:e-?[0-9]+)?)\s*(?:nms?|nanometers?|nanometres?)\s*\??\s*$/osi) {
$self->convertNanometers($event, $1);
} elsif ($message =~ m/^\s*(-?(?:[0-9]+\.?|[0-9]+\.[0-9]+|\.[0-9]+)(?:e-?[0-9]+)?)\s*(?:mms?|millimeters?|millimetres?)\s*\??\s*$/osi) {
$self->convertMillimeters($event, $1);
} elsif ($message =~ m/^\s*(-?(?:[0-9]+\.?|[0-9]+\.[0-9]+|\.[0-9]+)(?:e-?[0-9]+)?)\s*(?:cms?|centimeters?|centimetres?)\s*\??\s*$/osi) {
$self->convertCentimeters($event, $1);
} elsif ($message =~ m/^\s*(-?(?:[0-9]+\.?|[0-9]+\.[0-9]+|\.[0-9]+)(?:e-?[0-9]+)?)\s*(?:m|meters?|metres?)\s*\??\s*$/osi) {
$self->convertMeters($event, $1);
} elsif ($message =~ m/^\s*(-?(?:[0-9]+\.?|[0-9]+\.[0-9]+|\.[0-9]+)(?:e-?[0-9]+)?)\s*(?:kms?|kilometers?|kilometres?|klic?ks?)\s*\??\s*$/osi) {
$self->convertKilometers($event, $1);
# times
} elsif ($message =~ m/^\s*(-?(?:[0-9]+\.?|[0-9]+\.[0-9]+|\.[0-9]+)(?:e-?[0-9]+)?)\s*(?:years|year|yr)\s*\??\s*$/osi) {
$self->convertYears($event, $1);
} elsif ($message =~ m/^\s*(-?(?:[0-9]+\.?|[0-9]+\.[0-9]+|\.[0-9]+)(?:e-?[0-9]+)?)\s*(?:months|month|mo)\s*\??\s*$/osi) {
$self->convertMonths($event, $1);
} elsif ($message =~ m/^\s*(-?(?:[0-9]+\.?|[0-9]+\.[0-9]+|\.[0-9]+)(?:e-?[0-9]+)?)\s*(?:weeks|week|wk)\s*\??\s*$/osi) {
$self->convertWeeks($event, $1);
} elsif ($message =~ m/^\s*(-?(?:[0-9]+\.?|[0-9]+\.[0-9]+|\.[0-9]+)(?:e-?[0-9]+)?)\s*(?:fortnights|fortnight|mf)\s*\??\s*$/osi) {
$self->convertMillifortnights($event, $1);
} elsif ($message =~ m/^\s*(-?(?:[0-9]+\.?|[0-9]+\.[0-9]+|\.[0-9]+)(?:e-?[0-9]+)?)\s*(?:days|day|d)\s*\??\s*$/osi) {
$self->convertDays($event, $1);
} elsif ($message =~ m/^\s*(-?(?:[0-9]+\.?|[0-9]+\.[0-9]+|\.[0-9]+)(?:e-?[0-9]+)?)\s*(?:hours|hour|hr|h)\s*\??\s*$/osi) {
$self->convertHours($event, $1);
} elsif ($message =~ m/^\s*(-?(?:[0-9]+\.?|[0-9]+\.[0-9]+|\.[0-9]+)(?:e-?[0-9]+)?)\s*(?:minutes|minute|min)\s*\??\s*$/osi) {
$self->convertMinutes($event, $1);
} elsif ($message =~ m/^\s*(-?(?:[0-9]+\.?|[0-9]+\.[0-9]+|\.[0-9]+)(?:e-?[0-9]+)?)\s*(?:seconds|second|sec|s)\s*\??\s*$/osi) {
$self->convertSeconds($event, $1);
# masses
} elsif ($message =~ m/^\s*(-?(?:[0-9]+\.?|[0-9]+\.[0-9]+|\.[0-9]+)(?:e-?[0-9]+)?)\s*(?:grams|gram|g)\s*\??\s*$/osi) {
$self->convertGrams($event, $1);
} elsif ($message =~ m/^\s*(-?(?:[0-9]+\.?|[0-9]+\.[0-9]+|\.[0-9]+)(?:e-?[0-9]+)?)\s*(?:kilograms|kilogram|kilos|kilo|kg)\s*\??\s*$/osi) {
$self->convertKilograms($event, $1);
} elsif ($message =~ m/^\s*(-?(?:[0-9]+\.?|[0-9]+\.[0-9]+|\.[0-9]+)(?:e-?[0-9]+)?)\s*(?:pounds|pound|lbs)\s*\??\s*$/osi) {
$self->convertPounds($event, $1);
} elsif ($message =~ m/^\s*(-?(?:[0-9]+\.?|[0-9]+\.[0-9]+|\.[0-9]+)(?:e-?[0-9]+)?)\s*(?:ounces|ounce|oz)\s*\??\s*$/osi) {
$self->convertOunces($event, $1);
} elsif ($message =~ m/^\s*(-?(?:[0-9]+\.?|[0-9]+\.[0-9]+|\.[0-9]+)(?:e-?[0-9]+)?)\s*(?:stones|stone)\s*\??\s*$/osi) {
$self->convertStones($event, $1);
# oh well
} else {
return $self->SUPER::Told(@_);
}
return 0;
}
# Integers
sub convertDecimal {
my $self = shift;
my($event, $decimal) = @_;
my $hex = sprintf('%X', $decimal);
my $octal = sprintf('%o', $decimal);
my $binary = sprintf('%b', $decimal);
$self->say($event, "$event->{'from'}: $decimal = 0x$hex, 0$octal, 0b$binary");
}
sub convertHex {
my $self = shift;
my($event, $hex) = @_;
my $decimal = hex($hex);
my $hex = sprintf('%X', $decimal); # normalise
my $octal = sprintf('%o', $decimal);
my $binary = sprintf('%b', $decimal);
$self->say($event, "$event->{'from'}: 0x$hex = $decimal, 0$octal, 0b$binary");
}
sub convertOctal {
my $self = shift;
my($event, $octal) = @_;
my $decimal = oct("0$octal");
my $hex = sprintf('%X', $decimal);
my $binary = sprintf('%b', $decimal);
$self->say($event, "$event->{'from'}: 0$octal = $decimal, 0x$hex, 0b$binary");
}
sub convertBinary {
my $self = shift;
my($event, $binary) = @_;
my $decimal = oct("0b$binary");
my $hex = sprintf('%X', $decimal);
my $octal = sprintf('%o', $decimal);
$self->say($event, "$event->{'from'}: 0b$binary = $decimal, 0x$hex, 0$octal");
}
# Temperature
sub convertKelvin {
my $self = shift;
my($event, $kelvin) = @_;
my $celsius = round(1, $kelvin - 273.14);
my $fahrenheit = round(1, ($kelvin - 273.14) * 9 / 5 + 32);
my $kelvin = round(1, $kelvin); # normalise
my $prognosis = diagnoseTemperature($kelvin, $celsius, $fahrenheit);
$self->say($event, "$event->{'from'}: ${kelvin}K = $celsius°C, $fahrenheit°F, $prognosis");
}
sub convertCelsius {
my $self = shift;
my($event, $celsius) = @_;
my $kelvin = round(1, $celsius + 273.14);
my $fahrenheit = round(1, $celsius * 9 / 5 + 32);
my $celsius = round(1, $celsius); # normalise
my $prognosis = diagnoseTemperature($kelvin, $celsius, $fahrenheit);
$self->say($event, "$event->{'from'}: $celsius°C = ${kelvin}K, $fahrenheit°F, $prognosis");
}
sub convertFahrenheit {
my $self = shift;
my($event, $fahrenheit) = @_;
my $celsius = round(1, ($fahrenheit - 32) * 5 / 9);
my $kelvin = round(1, ($fahrenheit - 32) * 5 / 9 + 273.14);
my $fahrenheit = round(1, $fahrenheit); # normalise
my $prognosis = diagnoseTemperature($kelvin, $celsius, $fahrenheit);
$self->say($event, "$event->{'from'}: $fahrenheit°F = ${kelvin}K, $celsius°C, $prognosis");
}
sub diagnoseTemperature($$$) {
my($kelvin, $celsius, $fahrenheit) = @_;
return
$kelvin < 0 ? 'an impossible temperature' :
$kelvin == 0 ? 'absolute zero' :
$fahrenheit < 0 ? 'extremely cold' :
$celsius < 0 ? 'freezing cold' :
$celsius == 0 ? 'freezing point of water' :
$celsius < 18 ? 'cold' :
$celsius == 20 ? 'standard room temperature' :
$celsius < 25 ? 'warm' :
$celsius < 35 ? 'hot' :
$celsius <= 37 ? 'body temperature' :
$celsius < 65 ? 'very hot' :
$celsius < 95 ? 'scorching hot' :
$celsius == 100 ? 'boiling point of water' :
$celsius < 105 ? 'boiling hot' :
'ridiculously hot';
}
# Imperial Lengths
sub convertInches {
my $self = shift;
my($event, $inches) = @_;
# imperial
# (inches)
my $feet = sigfig(3, $inches / 12.0);
my $yards = sigfig(3, $inches / 36.0);
my $miles = sigfig(3, $inches / 63360.0);
# metric
my $kilometers = sigfig(3, $inches * 0.0000254);
my $meters = sigfig(3, $inches * 0.0254);
my $centimeters = sigfig(3, $inches * 2.54);
my $millimeters = sigfig(3, $inches * 25.4);
my $nanometers = sigfig(3, $inches * 25400000.0);
my $angstroms = sigfig(3, $inches * 254000000.0);
# normalise
my $inches = sigfig(3, $inches);
$self->say($event, "$event->{'from'}: ${inches}in = ${feet}ft, ${yards}yd, ${miles}mi; ${kilometers}Km, ${meters}m, ${centimeters}cm, ${millimeters}mm, ${nanometers}nm, ${angstroms}Å (to 3sf)");
}
sub convertFeet {
my $self = shift;
my($event, $feet) = @_;
my $inches = $feet * 12.0;
# imperial
# (inches)
my $feet = sigfig(3, $inches / 12.0);
my $yards = sigfig(3, $inches / 36.0);
my $miles = sigfig(3, $inches / 63360.0);
# metric
my $kilometers = sigfig(3, $inches * 0.0000254);
my $meters = sigfig(3, $inches * 0.0254);
my $centimeters = sigfig(3, $inches * 2.54);
my $millimeters = sigfig(3, $inches * 25.4);
my $nanometers = sigfig(3, $inches * 25400000.0);
my $angstroms = sigfig(3, $inches * 254000000.0);
# normalise
my $inches = sigfig(3, $inches);
$self->say($event, "$event->{'from'}: ${feet}ft = ${inches}in, ${yards}yd, ${miles}mi, ${kilometers}Km, ${meters}m, ${centimeters}cm, ${millimeters}mm, ${nanometers}nm, ${angstroms}Å (to 3sf)");
}
sub convertYards {
my $self = shift;
my($event, $yards) = @_;
my $inches = $yards * 36.0;
# imperial
# (inches)
my $feet = sigfig(3, $inches / 12.0);
my $yards = sigfig(3, $inches / 36.0);
my $miles = sigfig(3, $inches / 63360.0);
# metric
my $kilometers = sigfig(3, $inches * 0.0000254);
my $meters = sigfig(3, $inches * 0.0254);
my $centimeters = sigfig(3, $inches * 2.54);
my $millimeters = sigfig(3, $inches * 25.4);
my $nanometers = sigfig(3, $inches * 25400000.0);
my $angstroms = sigfig(3, $inches * 254000000.0);
# normalise
my $inches = sigfig(3, $inches);
$self->say($event, "$event->{'from'}: ${yards}yd = ${inches}in, ${feet}ft, ${miles}mi, ${kilometers}Km, ${meters}m, ${centimeters}cm, ${millimeters}mm, ${nanometers}nm, ${angstroms}Å (to 3sf)");
}
sub convertMiles {
my $self = shift;
my($event, $miles) = @_;
my $inches = $miles * 190080.0;
# imperial
# (inches)
my $feet = sigfig(3, $inches / 12.0);
my $yards = sigfig(3, $inches / 36.0);
my $miles = sigfig(3, $inches / 63360.0);
# metric
my $kilometers = sigfig(3, $inches * 0.0000254);
my $meters = sigfig(3, $inches * 0.0254);
my $centimeters = sigfig(3, $inches * 2.54);
my $millimeters = sigfig(3, $inches * 25.4);
my $nanometers = sigfig(3, $inches * 25400000.0);
my $angstroms = sigfig(3, $inches * 254000000.0);
# normalise
my $inches = sigfig(3, $inches);
$self->say($event, "$event->{'from'}: ${miles}mi = ${inches}in, ${feet}ft, ${yards}yd, ${kilometers}Km, ${meters}m, ${centimeters}cm, ${millimeters}mm, ${nanometers}nm, ${angstroms}Å (to 3sf)");
}
# Metric Lengths
sub convertAngstroms {
my $self = shift;
my($event, $input) = @_;
# get the number
my $accurateMeters = $input / 10000000000.0;
$self->debug("Accurate KiloMeters: ".$accurateMeters/1000);
# imperial
my $inches = sigfig(3, $accurateMeters / (0.0254 * 1.0));
my $feet = sigfig(3, $accurateMeters / (0.0254 * 12.0));
my $yards = sigfig(3, $accurateMeters / (0.0254 * 36.0));
my $miles = sigfig(3, $accurateMeters / (0.0254 * 63360.0));
# metric
my $kilometers = sigfig(3, $accurateMeters / 1000.0);
my $meters = sigfig(3, $accurateMeters);
my $centimeters = sigfig(3, $accurateMeters * 100.0);
my $millimeters = sigfig(3, $accurateMeters * 1000.0);
my $nanometers = sigfig(3, $accurateMeters * 1000000000.0);
my $angstroms = sigfig(3, $accurateMeters * 10000000000.0);
$self->say($event, "$event->{'from'}: ${angstroms}Å = ${inches}in, ${feet}ft, ${yards}yd, ${miles}mi; ${kilometers}Km, ${meters}m, ${centimeters}cm, ${millimeters}mm, ${nanometers}nm (to 3sf)");
}
sub convertNanometers {
my $self = shift;
my($event, $input) = @_;
# get the number
my $accurateMeters = $input / 1000000000.0;
# imperial
my $inches = sigfig(3, $accurateMeters / (0.0254 * 1.0));
my $feet = sigfig(3, $accurateMeters / (0.0254 * 12.0));
my $yards = sigfig(3, $accurateMeters / (0.0254 * 36.0));
my $miles = sigfig(3, $accurateMeters / (0.0254 * 63360.0));
# metric
my $kilometers = sigfig(3, $accurateMeters / 1000.0);
my $meters = sigfig(3, $accurateMeters);
my $centimeters = sigfig(3, $accurateMeters * 100.0);
my $millimeters = sigfig(3, $accurateMeters * 1000.0);
my $nanometers = sigfig(3, $accurateMeters * 1000000000.0);
my $angstroms = sigfig(3, $accurateMeters * 10000000000.0);
$self->say($event, "$event->{'from'}: ${nanometers}nm = ${inches}in, ${feet}ft, ${yards}yd, ${miles}mi; ${kilometers}Km, ${meters}m, ${centimeters}cm, ${millimeters}mm, ${angstroms}Å (to 3sf)");
}
sub convertMillimeters {
my $self = shift;
my($event, $input) = @_;
# get the number
my $accurateMeters = $input / 1000.0;
# imperial
my $inches = sigfig(3, $accurateMeters / (0.0254 * 1.0));
my $feet = sigfig(3, $accurateMeters / (0.0254 * 12.0));
my $yards = sigfig(3, $accurateMeters / (0.0254 * 36.0));
my $miles = sigfig(3, $accurateMeters / (0.0254 * 63360.0));
# metric
my $kilometers = sigfig(3, $accurateMeters / 1000.0);
my $meters = sigfig(3, $accurateMeters);
my $centimeters = sigfig(3, $accurateMeters * 100.0);
my $millimeters = sigfig(3, $accurateMeters * 1000.0);
my $nanometers = sigfig(3, $accurateMeters * 1000000000.0);
my $angstroms = sigfig(3, $accurateMeters * 10000000000.0);
$self->say($event, "$event->{'from'}: ${millimeters}mm = ${inches}in, ${feet}ft, ${yards}yd, ${miles}mi; ${kilometers}Km, ${meters}m, ${centimeters}cm, ${nanometers}nm, ${angstroms}Å (to 3sf)");
}
sub convertCentimeters {
my $self = shift;
my($event, $input) = @_;
# get the number
my $accurateMeters = $input / 100.0;
# imperial
my $inches = sigfig(3, $accurateMeters / (0.0254 * 1.0));
my $feet = sigfig(3, $accurateMeters / (0.0254 * 12.0));
my $yards = sigfig(3, $accurateMeters / (0.0254 * 36.0));
my $miles = sigfig(3, $accurateMeters / (0.0254 * 63360.0));
# metric
my $kilometers = sigfig(3, $accurateMeters / 1000.0);
my $meters = sigfig(3, $accurateMeters);
my $centimeters = sigfig(3, $accurateMeters * 100.0);
my $millimeters = sigfig(3, $accurateMeters * 1000.0);
my $nanometers = sigfig(3, $accurateMeters * 1000000000.0);
my $angstroms = sigfig(3, $accurateMeters * 10000000000.0);
$self->say($event, "$event->{'from'}: ${centimeters}cm = ${inches}in, ${feet}ft, ${yards}yd, ${miles}mi; ${kilometers}Km, ${meters}m, ${millimeters}mm, ${nanometers}nm, ${angstroms}Å (to 3sf)");
}
sub convertMeters {
my $self = shift;
my($event, $input) = @_;
# get the number
my $accurateMeters = $input * 1.0;
# imperial
my $inches = sigfig(3, $accurateMeters / (0.0254 * 1.0));
my $feet = sigfig(3, $accurateMeters / (0.0254 * 12.0));
my $yards = sigfig(3, $accurateMeters / (0.0254 * 36.0));
my $miles = sigfig(3, $accurateMeters / (0.0254 * 63360.0));
# metric
my $kilometers = sigfig(3, $accurateMeters / 1000.0);
my $meters = sigfig(3, $accurateMeters);
my $centimeters = sigfig(3, $accurateMeters * 100.0);
my $millimeters = sigfig(3, $accurateMeters * 1000.0);
my $nanometers = sigfig(3, $accurateMeters * 1000000000.0);
my $angstroms = sigfig(3, $accurateMeters * 10000000000.0);
$self->say($event, "$event->{'from'}: ${meters}m = ${inches}in, ${feet}ft, ${yards}yd, ${miles}mi; ${kilometers}Km, ${centimeters}cm, ${millimeters}mm, ${nanometers}nm, ${angstroms}Å (to 3sf)");
}
sub convertKilometers {
my $self = shift;
my($event, $input) = @_;
# get the number
my $accurateMeters = $input * 1000.0;
# imperial
my $inches = sigfig(3, $accurateMeters / (0.0254 * 1.0));
my $feet = sigfig(3, $accurateMeters / (0.0254 * 12.0));
my $yards = sigfig(3, $accurateMeters / (0.0254 * 36.0));
my $miles = sigfig(3, $accurateMeters / (0.0254 * 63360.0));
# metric
my $kilometers = sigfig(3, $accurateMeters / 1000.0);
my $meters = sigfig(3, $accurateMeters);
my $centimeters = sigfig(3, $accurateMeters * 100.0);
my $millimeters = sigfig(3, $accurateMeters * 1000.0);
my $nanometers = sigfig(3, $accurateMeters * 1000000000.0);
my $angstroms = sigfig(3, $accurateMeters * 10000000000.0);
$self->say($event, "$event->{'from'}: ${kilometers}km = ${inches}in, ${feet}ft, ${yards}yd, ${miles}mi; ${meters}m, ${centimeters}cm, ${millimeters}mm, ${nanometers}nm, ${angstroms}Å (to 3sf)");
}
# Time
sub convertYears {
my $self = shift;
my($event, $input) = @_;
my $accurateSeconds = $input * 60.0 * 60.0 * 24.0 * 365.25;
my $years = sigfig(3, $input);
my $months = sigfig(3, $accurateSeconds / (60.0 * 60.0 * 24.0 * (365.25 / 12)));
my $weeks = sigfig(3, $accurateSeconds / (60.0 * 60.0 * 24.0 * (365.25 / (365.25 / 7.0))));
my $millifortnights = sigfig(3, $accurateSeconds / (60.0 * 60.0 * 24.0 * (365.25 / (365.25 / 7.0)) * 2.0 / 1000.0));
my $days = sigfig(3, $accurateSeconds / (60.0 * 60.0 * 24.0));
my $hours = sigfig(3, $accurateSeconds / (60.0 * 60.0));
my $minutes = sigfig(3, $accurateSeconds / 60.0);
my $seconds = sigfig(3, $accurateSeconds);
$self->say($event, "$event->{'from'}: ${years}yr = ${months}mo, ${weeks}wk, ${days}d, ${hours}hr, ${minutes}min, ${seconds}s, ${millifortnights}mf");
}
sub convertMonths {
my $self = shift;
my($event, $input) = @_;
my $accurateSeconds = $input * 60.0 * 60.0 * 24.0 * (365.25 / 12);
my $years = sigfig(3, $accurateSeconds / (60.0 * 60.0 * 24.0 * 365.25));
my $months = sigfig(3, $input);
my $weeks = sigfig(3, $accurateSeconds / (60.0 * 60.0 * 24.0 * (365.25 / (365.25 / 7.0))));
my $millifortnights = sigfig(3, $accurateSeconds / (60.0 * 60.0 * 24.0 * (365.25 / (365.25 / 7.0)) * 2.0 / 1000.0));
my $days = sigfig(3, $accurateSeconds / (60.0 * 60.0 * 24.0));
my $hours = sigfig(3, $accurateSeconds / (60.0 * 60.0));
my $minutes = sigfig(3, $accurateSeconds / 60.0);
my $seconds = sigfig(3, $accurateSeconds);
$self->say($event, "$event->{'from'}: ${months}mo = ${years}yr, ${weeks}wk, ${days}d, ${hours}hr, ${minutes}min, ${seconds}s, ${millifortnights}mf");
}
sub convertWeeks {
my $self = shift;
my($event, $input) = @_;
my $accurateSeconds = $input * 60.0 * 60.0 * 24.0 * 7.0;
my $years = sigfig(3, $accurateSeconds / (60.0 * 60.0 * 24.0 * 365.25));
my $months = sigfig(3, $accurateSeconds / (60.0 * 60.0 * 24.0 * (365.25 / 12)));
my $weeks = sigfig(3, $input);
my $millifortnights = sigfig(3, $accurateSeconds / (60.0 * 60.0 * 24.0 * (365.25 / (365.25 / 7.0)) * 2.0 / 1000.0));
my $days = sigfig(3, $accurateSeconds / (60.0 * 60.0 * 24.0));
my $hours = sigfig(3, $accurateSeconds / (60.0 * 60.0));
my $minutes = sigfig(3, $accurateSeconds / 60.0);
my $seconds = sigfig(3, $accurateSeconds);
$self->say($event, "$event->{'from'}: ${weeks}wk = ${years}yr, ${months}mo, ${days}d, ${hours}hr, ${minutes}min, ${seconds}s, ${millifortnights}mf");
}
sub convertMillifortnights {
my $self = shift;
my($event, $input) = @_;
my $accurateSeconds = $input * 60.0 * 60.0 * 24.0 * 7.0 * 2.0 / 1000.0;
my $years = sigfig(3, $accurateSeconds / (60.0 * 60.0 * 24.0 * 365.25));
my $months = sigfig(3, $accurateSeconds / (60.0 * 60.0 * 24.0 * (365.25 / 12)));
my $weeks = sigfig(3, $accurateSeconds / (60.0 * 60.0 * 24.0 * (365.25 / (365.25 / 7.0))));
my $millifortnights = sigfig(3, $accurateSeconds / (60.0 * 60.0 * 24.0 * (365.25 / (365.25 / 7.0)) * 2.0 / 1000.0));
my $days = sigfig(3, $accurateSeconds / (60.0 * 60.0 * 24.0));
my $hours = sigfig(3, $accurateSeconds / (60.0 * 60.0));
my $minutes = sigfig(3, $accurateSeconds / 60.0);
my $seconds = sigfig(3, $accurateSeconds);
$self->say($event, "$event->{'from'}: ${millifortnights}mf = ${years}yr, ${months}mo, ${weeks}wk, ${days}d, ${hours}hr, ${minutes}min, ${seconds}s");
}
sub convertDays {
my $self = shift;
my($event, $input) = @_;
my $accurateSeconds = $input * 60.0 * 60.0 * 24.0;
my $years = sigfig(3, $accurateSeconds / (60.0 * 60.0 * 24.0 * 365.25));
my $months = sigfig(3, $accurateSeconds / (60.0 * 60.0 * 24.0 * (365.25 / 12)));
my $weeks = sigfig(3, $accurateSeconds / (60.0 * 60.0 * 24.0 * (365.25 / (365.25 / 7.0))));
my $millifortnights = sigfig(3, $accurateSeconds / (60.0 * 60.0 * 24.0 * (365.25 / (365.25 / 7.0)) * 2.0 / 1000.0));
my $days = sigfig(3, $accurateSeconds / (60.0 * 60.0 * 24.0));
my $hours = sigfig(3, $accurateSeconds / (60.0 * 60.0));
my $minutes = sigfig(3, $accurateSeconds / 60.0);
my $seconds = sigfig(3, $accurateSeconds);
$self->say($event, "$event->{'from'}: ${days}d = ${years}yr, ${months}mo, ${weeks}wk, ${hours}hr, ${minutes}min, ${seconds}s, ${millifortnights}mf");
}
sub convertHours {
my $self = shift;
my($event, $input) = @_;
my $accurateSeconds = $input * 60.0 * 60.0;
my $years = sigfig(3, $accurateSeconds / (60.0 * 60.0 * 24.0 * 365.25));
my $months = sigfig(3, $accurateSeconds / (60.0 * 60.0 * 24.0 * (365.25 / 12)));
my $weeks = sigfig(3, $accurateSeconds / (60.0 * 60.0 * 24.0 * (365.25 / (365.25 / 7.0))));
my $millifortnights = sigfig(3, $accurateSeconds / (60.0 * 60.0 * 24.0 * (365.25 / (365.25 / 7.0)) * 2.0 / 1000.0));
my $days = sigfig(3, $accurateSeconds / (60.0 * 60.0 * 24.0));
my $hours = sigfig(3, $accurateSeconds / (60.0 * 60.0));
my $minutes = sigfig(3, $accurateSeconds / 60.0);
my $seconds = sigfig(3, $accurateSeconds);
$self->say($event, "$event->{'from'}: ${hours}hr = ${years}yr, ${months}mo, ${weeks}wk, ${days}d, ${minutes}min, ${seconds}s, ${millifortnights}mf");
}
sub convertMinutes {
my $self = shift;
my($event, $input) = @_;
my $accurateSeconds = $input * 60.0;
my $years = sigfig(3, $accurateSeconds / (60.0 * 60.0 * 24.0 * 365.25));
my $months = sigfig(3, $accurateSeconds / (60.0 * 60.0 * 24.0 * (365.25 / 12)));
my $weeks = sigfig(3, $accurateSeconds / (60.0 * 60.0 * 24.0 * (365.25 / (365.25 / 7.0))));
my $millifortnights = sigfig(3, $accurateSeconds / (60.0 * 60.0 * 24.0 * (365.25 / (365.25 / 7.0)) * 2.0 / 1000.0));
my $days = sigfig(3, $accurateSeconds / (60.0 * 60.0 * 24.0));
my $hours = sigfig(3, $accurateSeconds / (60.0 * 60.0));
my $minutes = sigfig(3, $accurateSeconds / 60.0);
my $seconds = sigfig(3, $accurateSeconds);
$self->say($event, "$event->{'from'}: ${minutes}min = ${years}yr, ${months}mo, ${weeks}wk, ${days}d, ${hours}hr, ${seconds}s, ${millifortnights}mf");
}
sub convertSeconds {
my $self = shift;
my($event, $input) = @_;
my $accurateSeconds = $input;
my $years = sigfig(3, $accurateSeconds / (60.0 * 60.0 * 24.0 * 365.25));
my $months = sigfig(3, $accurateSeconds / (60.0 * 60.0 * 24.0 * (365.25 / 12)));
my $weeks = sigfig(3, $accurateSeconds / (60.0 * 60.0 * 24.0 * (365.25 / (365.25 / 7.0))));
my $millifortnights = sigfig(3, $accurateSeconds / (60.0 * 60.0 * 24.0 * (365.25 / (365.25 / 7.0)) * 2.0 / 1000.0));
my $days = sigfig(3, $accurateSeconds / (60.0 * 60.0 * 24.0));
my $hours = sigfig(3, $accurateSeconds / (60.0 * 60.0));
my $minutes = sigfig(3, $accurateSeconds / 60.0);
my $seconds = sigfig(3, $accurateSeconds);
$self->say($event, "$event->{'from'}: ${seconds}s = ${years}yr, ${months}mo, ${weeks}wk, ${days}d, ${hours}hr, ${minutes}min, ${millifortnights}mf");
}
# Mass
sub convertGrams {
my $self = shift;
my($event, $input) = @_;
my $accurateGrams = $input;
my $grams = sigfig(3, $accurateGrams);
my $kgs = sigfig(3, $accurateGrams / 1000.0);
my $ounces = sigfig(3, $accurateGrams * 0.03527);
my $pounds = sigfig(3, $accurateGrams * 0.002205);
my $stones = sigfig(3, $accurateGrams * 0.00016);
$self->say($event, "$event->{'from'}: ${grams}g = ${kgs}kg, ${ounces}oz, ${pounds}lbs, ${stones}stone");
}
sub convertKilograms {
my $self = shift;
my($event, $input) = @_;
my $accurateGrams = $input * 1000.0;
my $grams = sigfig(3, $accurateGrams);
my $kgs = sigfig(3, $input);
my $ounces = sigfig(3, $accurateGrams * 0.03527);
my $pounds = sigfig(3, $accurateGrams * 0.002205);
my $stones = sigfig(3, $accurateGrams * 0.00016);
$self->say($event, "$event->{'from'}: ${kgs}kg = ${grams}g, ${ounces}oz, ${pounds}lbs, ${stones}stone");
}
sub convertPounds {
my $self = shift;
my($event, $input) = @_;
my $accurateGrams = $input * 453.6;
my $grams = sigfig(3, $accurateGrams);
my $kgs = sigfig(3, $accurateGrams / 1000.0);
my $ounces = sigfig(3, $accurateGrams * 0.03527);
my $pounds = sigfig(3, $input);
my $stones = sigfig(3, $accurateGrams * 0.00016);
$self->say($event, "$event->{'from'}: ${pounds}lbs = ${grams}g, ${kgs}kg, ${ounces}oz, ${stones}stone");
}
sub convertOunces {
my $self = shift;
my($event, $input) = @_;
my $accurateGrams = $input * 28.35;
my $grams = sigfig(3, $accurateGrams);
my $kgs = sigfig(3, $accurateGrams / 1000.0);
my $ounces = sigfig(3, $input);
my $pounds = sigfig(3, $accurateGrams * 0.002205);
my $stones = sigfig(3, $accurateGrams * 0.00016);
$self->say($event, "$event->{'from'}: ${ounces}oz = ${grams}g, ${kgs}kg, ${pounds}lbs, ${stones}stone");
}
sub convertStones {
my $self = shift;
my($event, $input) = @_;
my $accurateGrams = $input * 6350.3;
my $grams = sigfig(3, $accurateGrams);
my $kgs = sigfig(3, $accurateGrams / 1000.0);
my $ounces = sigfig(3, $accurateGrams * 0.03527);
my $pounds = sigfig(3, $accurateGrams * 0.002205);
my $stones = sigfig(3, $accurateGrams * 0.00016);
$self->say($event, "$event->{'from'}: ${stones}stone = ${grams}g, ${kgs}kg, ${ounces}oz, ${pounds}lbs");
}
# Utility Functions
sub round($$) {
return sprintf("%.*f", @_);
}
sub sigfig($$) {
my($sf, $float) = @_;
my $length = length(int($float));
if ($length == $sf) {
$float = int($float);
} elsif ($length > $sf) {
my $factor = (10 ** ($length - $sf));
$float = int($float / $factor) * $factor;
} else {
my $factor = 0;
while (length(int($float * 10 ** $factor)) < $sf) {
$factor++;
}
$float = int($float * 10 ** $factor) / (10 ** $factor);
}
$float = sprintf("%g", $float);
$float =~ s/e(?:\+|(-))0*/x10^$1/os;
return $float;
}

View File

@@ -1,60 +0,0 @@
# -*- Mode: perl; tab-width: 4; indent-tabs-mode: nil; -*-
################################
# Currencies Module #
################################
# Originally by Alex Schuilenburg <alex@schuilenburg.org>
package BotModules::Currencies;
use vars qw(@ISA);
@ISA = qw(BotModules);
1;
sub Help {
my $self = shift;
my ($event) = @_;
return {
'' => 'This module gets mid-market currency exchange rates from: http://www.xe.com/ucc/full.shtml',
'currency' => 'Call this command with two currency symbols to get the exchange rate. Syntax: \'currency [value] SYM/SYM\'. For the list of supported currencies, see: http://www.xe.com/iso4217.htm',
};
}
sub Told {
my $self = shift;
my ($event, $message) = @_;
if ($message =~ /^\s*(?:currency|how\s+much\s+is|what\s+is|what\s+are)\s+(\d*(?:.\d+)?)\s*([A-Z]{3})s?\s*(?:\/|in|as)\s*([A-Z]{3})s?[\s?!.]*$/osi) {
my $amount = $1 || 1;
my $from = uc $2;
my $to = uc $3;
$self->getURI($event, "http://www.xe.com/ucc/convert.cgi?From=$from&To=$to&Amount=$amount", 'currency', $from, $to);
} else {
return $self->SUPER::Told(@_);
}
return 0; # we've dealt with it, no need to do anything else.
}
sub GotURI {
my $self = shift;
my ($event, $uri, $output, $cmd, $from, $to) = @_;
$self->debug($output);
my $message = "$event->{'from'}: ";
if ($cmd eq 'currency') {
my $fromval;
if ($output =~ m/([\d,]+\.\d+)\s+$from/s) {
$fromval = $1;
}
my $toval;
if ($output =~ m/([\d,]+\.\d+)\s+$to/s) {
$toval = $1;
}
if (defined $fromval and defined $toval) {
$message .= "$fromval $from = $toval $to (mid-market rates from xe.com)";
} elsif ($output =~ m/The following error occurred:<BR><BR>\s*(.+?)\s*<\//os) {
$message .= "xe.com said: $1";
} else {
$message .= 'I\'m afraid I can\'t get currency conversions right now. Sorry.';
}
} else {
return $self->SUPER::GotURI(@_);
}
$self->say($event, $message);
}

View File

@@ -1,248 +0,0 @@
################################
# FTP Module #
################################
package BotModules::FTP;
use vars qw(@ISA);
use Net::FTP;
@ISA = qw(BotModules);
1;
# RegisterConfig - Called when initialised, should call registerVariables
sub RegisterConfig {
my $self = shift;
$self->SUPER::RegisterConfig(@_);
$self->registerVariables(
# [ name, save?, settable? ]
['host', 1, 1, 'ftp.mozilla.org'],
['path', 1, 1, '/pub/mozilla/nightly/latest'],
['updateDelay', 1, 1, 600],
['preferredLineLength', 1, 1, 80],
['data', 0, 0, {}], # data -> file -> datetime stamp
['mutes', 1, 1, ''], # "channel channel channel"
);
}
# Schedule - called when bot connects to a server, to install any schedulers
# use $self->schedule($event, $delay, $times, $data)
# where $times is 1 for a single event, -1 for recurring events,
# and a +ve number for an event that occurs that many times.
sub Schedule {
my $self = shift;
my ($event) = @_;
$self->schedule($event, \$self->{'updateDelay'}, -1, 'ftp');
$self->SUPER::Schedule($event);
}
sub Help {
my $self = shift;
my ($event) = @_;
my %commands = (
'' => "This module monitors the FTP site 'ftp://$self->{'host'}$self->{'path'}/' and reports new files as they appear.",
'ftp' => 'On its own, lists the currently available files. With a suffix, does a substring search and reports all files matching that pattern. Syntax: \'ftp [pattern]\'',
);
if ($self->isAdmin($event)) {
$commands{'mute'} = 'Disable reporting of new files in a channel. Syntax: mute ftp in <channel>';
$commands{'unmute'} = 'Enable reporting of new files in a channel. Syntax: unmute ftp in <channel>';
}
return \%commands;
}
sub Told {
my $self = shift;
my ($event, $message) = @_;
if ($message =~ /^\s*ftp(?:\s+(\S+?))?\s*\?*\s*$/osi) {
$self->spawnChild($event, \&ftp_check, [$self, $self->{'path'}, $self->{'host'}], 'ftp', [$event, $1]);
} elsif ($self->isAdmin($event)) {
if ($message =~ /^\s*mute\s+ftp\s+in\s+(\S+?)\s*$/osi) {
$self->{'mutes'} .= " $1";
$self->saveConfig();
$self->say($event, "$event->{'from'}: Reporting of new files disabled in channel $1.");
} elsif ($message =~ /^\s*unmute\s+ftp\s+in\s+(\S+)\s*$/osi) {
my %mutedChannels = map { $_ => 1 } split(/ /o, $self->{'mutes'});
delete($mutedChannels{$1}); # get rid of any mentions of that channel
$self->{'mutes'} = join(' ', keys(%mutedChannels));
$self->saveConfig();
$self->say($event, "$event->{'from'}: Reporting of new files reenabled in channel $1.");
} else {
return $self->SUPER::Told(@_);
}
} else {
return $self->SUPER::Told(@_);
}
}
sub Scheduled {
my $self = shift;
my ($event, @data) = @_;
if ($data[0] eq 'ftp') {
$self->spawnChild($event, \&ftp_check, [$self, $self->{'path'}, $self->{'host'}], 'ftp', [undef]);
} else {
$self->SUPER::Scheduled($event, @data);
}
}
# ChildCompleted - Called when a child process has quit
sub ChildCompleted {
my $self = shift;
my ($event, $type, $output, @data) = @_;
if ($type eq 'ftp') {
my @output = split(/\n/os, $output);
if (shift(@output)) {
my @new = ();
while (@output) {
my ($file, $stamp) = (shift(@output), shift(@output));
if ((defined($self->{'data'}->{$file})) and ($self->{'data'}->{$file} < $stamp)) {
push(@new, $file);
}
$self->{'data'}->{$file} = $stamp;
}
if ((defined($self->{'_ready'})) and (scalar(@new))) {
my $s = scalar(@new) > 1 ? 's' : '';
@output = $self->prettyPrint($self->{'preferredLineLength'},
"New file$s in ftp://$self->{'host'}$self->{'path'}/ : ",
'', ' ', @new);
foreach my $channel (@{$self->{'channels'}}) {
unless ($self->{'mutes'} =~ /^(.*\s|)\Q$channel\E(|\s.*)$/si) {
$event->{'target'} = $channel;
foreach (@output) {
$self->say($event, $_);
}
}
}
}
$self->{'_ready'} = 1;
if ($data[0]) {
$self->ftp_stamp($event, $data[1]);
}
} else {
if ($data[0]) {
$self->say($event, "I could not contact $self->{'host'}, sorry.");
}
$self->tellAdmin($event, "Dude, I'm having a problem with FTP. Could you prod $self->{'host'} for me please? Or fix my config? Cheers.");
}
} else {
$self->SUPER::ChildCompleted($event, $type, $output, @data);
}
}
# The following is directly from the original techbot (mozbot 1.5), written by timeless.
# The only changes I made were to port it to the mozbot2 architecture. Those changes
# are commented.
sub day_str {
my (@stamp,$ahr,$amn,$asc);
($asc, $amn, $ahr, @stamp)=gmtime($_[3]);
$asc = "0$asc" if $asc < 10; # \
$amn = "0$amn" if $amn < 10; # -- added these to zero-pad output
$ahr = "0$ahr" if $ahr < 10; # /
return "$_[4] ($ahr:$amn:$asc) " # added extra space to neaten output
if ($stamp[0]==$_[0] && $stamp[1]==$_[1] && $stamp[2]==$_[2]);
}
sub ftp_stamp {
# It seems that the original wanted ($to, $cmd, $rest) as the arguments.
# However, it doesn't use $to except at the end (which we replace) and
# it doesn't use $cmd at all. This is lucky for us, since the first
# argument of methods is always the object ref.
my $self = $_[0];
# This function also expects to be able to use a global (!) variable
# called %latestbuilds. We grandfather that by making a lexically scoped
# copy of one of our object fields.
my %latestbuilds = %{$self->{'data'}};
# We have to keep a copy of $event around for when we send out the
# output, of course. So let's use the second argument for that:
my $event = $_[1];
# Finally, we have to work around a serious bug in the original version,
# which assumed any pattern input was valid regexp. [XXX use eval]
$_[2] = defined($_[2]) ? quotemeta($_[2]) : 0;
# In summary, call this function like this:
# $self->ftp_stamp($event, $pattern);
# various instances of time() below were changed to use $event->{'time'}
# so that we are less prone to time drift
my @day=gmtime($event->{'time'}); my @tm=@day[0..2]; @day=@day[3..5];
my (@filestamp, $filelist, $ahr,$amn,$asc);
if ($_[2]){ # this code's output is *VERY* ugly. But I just took it as is, so deal with it. Patches welcome.
foreach my $filename (keys %latestbuilds){
my @ltm=gmtime($latestbuilds{$filename});
$filelist.="$filename [".($ltm[5]+1900).'-'.($ltm[4]+1)."-$ltm[3] $ltm[2]:$ltm[1]:$ltm[0]]"
if $filename=~/$_[2]/;
}
$filelist=$filelist||'<nothing matched>';
$filelist="Files matching re:$_[2] [gmt] $filelist";
}else{
foreach my $filename (keys %latestbuilds){
$filelist.=day_str(@day[0..2],$latestbuilds{$filename},$filename);
}
if ($filelist){
$filelist="Files from today [gmt] $filelist";
} else {
foreach my $filename (keys %latestbuilds){
@day=gmtime($event->{'time'}-86400); @day=@day[3..5];
$filelist.=day_str(@day[0..2],$latestbuilds{$filename},$filename);
}
$filelist="Files from yesterday [gmt] $filelist"|| # next line changed from " to \' and added missing '>'
'<No files in the past two days by gmt, try \'ftp .\' for a complete filelist>';
}
}
# Append the current time for those not in GMT time zones
my @time;
foreach (@tm) {
# zero pad the time
$_ = "0$_" if $_ < 10;
# switch digits around (@tm is in reverse order)
unshift(@time, $_);
}
# output
local $";
$" = ':';
$filelist .= " time now: @time";
# Ok, now we want to send out the results (held in $filelist).
$self->say($event, $filelist);
}
sub ftp_check {
# ok, this function has been hacked for the new architecture.
# ftp_check is called in a spawned child.
# It returns the output in a fixed format back to the parent
# process. The format is
# 1
# file
# timestamp
# file
# timestamp
# if it fails, the '1' will be missing (no output).
# It should be passed the following arguments:
# [$self, $path, $server]
my $self = $_[0];
my $output = '';
my $buf='';
my $mdtms;
my $ftpserver=$_[2];
my $ftp = new Net::FTP($ftpserver, Debug => 0, Passive => 1);
if ($ftp){
$output .= "1\n"; # how we find out if it worked or not
if ($ftp->login('anonymous','mozbot@localhost')){
$ftp->cwd($_[1]); # path used to be hardcoded
for my $f ($ftp->ls){
$mdtms=$ftp->mdtm($f);
$output .= "$f\n$mdtms\n"; # output to pipe instead of irc
}
$ftp->quit;
};
}
# now send out the buffered output
return $output;
}

View File

@@ -1,83 +0,0 @@
################################
# Filter Module #
################################
# The canonical filters should be installed on your path somewhere.
# You can get the source from these from your local distributor.
package BotModules::Filter;
use vars qw(@ISA);
use IPC::Open2;
@ISA = qw(BotModules);
1;
my @Filters = (
'b1ff',
'chef',
'cockney',
'eleet',
'jethro',
'jibberish',
'jive',
'kraut',
'nyc',
'rasterman',
'upside-down',
);
sub Help {
my $self = shift;
my ($event) = @_;
my $reply = {
'' => 'This module is an interface to the text filter applications.',
};
foreach (@Filters) {
$reply->{$_} = "Pass the text through the $_ filter. Syntax: $_ <text>";
}
if ($self->isAdmin($event)) {
$reply->{'filtersay'} = "Pass text through a filter and send it to a channel. Syntax: filtersay <filter> <channel> <text>";
}
return $reply;
}
sub Told {
my $self = shift;
my ($event, $message) = @_;
foreach (@Filters) {
if ($message =~ /^\s*\Q$_\E\s+(.+?)\s*$/si) {
$self->spawnChild($event, sub { return $self->Filter(@_); }, [$_, $1], 'filter', []);
return 0; # we've dealt with it, no need to do anything else.
} elsif (($message =~ /^\s*filtersay\s+\Q$_\E\s+(\S+)\s+(.+?)\s*$/si) and ($self->isAdmin($event))) {
$self->spawnChild($event, sub { return $self->Filter(@_); }, [$_, $2], 'filter', [$1]);
return 0; # we've dealt with it, no need to do anything else.
}
}
return $self->SUPER::Told(@_);
}
sub Filter {
my $self = shift;
my($filter, $text) = @_;
my $reader;
my $writer;
local $/ = undef;
my $pid = open2($reader, $writer, $filter);
print $writer $text;
close($writer);
my $reply = <$reader>;
close($reader);
waitpid($pid, 0);
return $reply;
}
# ChildCompleted - Called when a child process has quit
sub ChildCompleted {
my $self = shift;
my ($event, $type, $output, @data) = @_;
if ($type eq 'filter') {
local $event->{'target'} = $data[0] if defined($data[0]);
$self->say($event, $output);
} else {
return $self->SUPER::ChildCompleted(@_);
}
}

View File

@@ -1,102 +0,0 @@
# -*- Mode: perl; indent-tabs-mode: nil -*-
# $Id: Flood.bm,v 1.2 2003-10-03 15:46:54 ian%hixie.ch Exp $
###########################
# Flood Protection module #
###########################
package BotModules::Flood;
use vars qw(@ISA);
@ISA = qw(BotModules);
1;
sub RegisterConfig {
my $self = shift;
$self->SUPER::RegisterConfig(@_);
foreach my $chan (@{$self->{'channels'}}) {
$self->registerVariables( ["join_$chan", 0, 0, []] );
}
$self->registerVariables(
['numberOfJoins', 1, 1, '7'],
['secondsToTrigger', 1, 1, '2'],
['minutesToProtect', 1, 1, '5'],
);
}
sub Help {
my $self = shift;
my ($event) = @_;
return {
'' => 'This module will help control "join flood" attacks on IRC',
};
}
# Set - called to set a variable to a particular value.
sub Set {
my $self = shift;
my ($event, $variable, $value) = @_;
# If changing the setting for numberOfJoins make sure
# that the arrays are empty. Otherwise, reducing the
# numberOfJoins value would not work properly.
if ($variable eq 'numberOfJoins') {
foreach my $chan (@{$self->{'channels'}}) {
@{$self->{"join_$chan"}} = ();
}
}
# now actually do the setting of the variable
return $self->SUPER::Set($event, $variable, $value);
}
sub JoinedChannel {
my $self = shift;
my ($event, $channel) = @_;
$self->registerVariables( ["join_$channel", 0, 0, []] );
return $self->SUPER::JoinedChannel($event, $channel); # call inherited method
}
sub SpottedJoin {
my $self = shift;
my ($event, $channel, $who) = @_;
# If numberOfJoins or secondsToTrigger is not a positive Integer, don't do anything
if ($self->{'numberOfJoins'} !~ m/^[1-9][0-9]*$/o || $self->{'secondsToTrigger'} !~ m/^[1-9][0-9]*$/o) {
# We didn't do anything, so don't pretend like we did :)
return $self->SUPER::SpottedJoin($event, $channel, $who);
}
# Here we have the 'join_times' array to push and shift to/from
push(@{$self->{"join_$channel"}}, $event->{'time'});
if (scalar(@{$self->{"join_$channel"}}) >= $self->{'numberOfJoins'}) {
my $oldest = shift(@{$self->{"join_$channel"}});
my $timechange = $event->{'time'} - $oldest;
if ($self->{'secondsToTrigger'} >= $timechange) {
# We have just seen many joins happen very quickly. This channel should
# have its mode set to +i until an op can figure out what went wrong.
$self->mode($event, $event->{'channel'}, '+i');
my $extra_text = "";
# If minutesToProtect is a positive integer we should set mode -i after
# that number of minutes has passed.
if ($self->{'minutesToProtect'} =~ m/^[1-9][0-9]*$/o) {
my $seconds = $self->{'minutesToProtect'} * 60;
my @mode = ('mode', $event->{'channel'}, '-i');
$self->schedule($event, $seconds, 1, @mode);
$extra_text = "I'll set it -i in $self->{'minutesToProtect'} minutes";
}
$self->say($event, "I just saw a lot of joins happen very quickly. Because of " .
"that I set this channel's mode to be Invite Only... $extra_text");
}
}
# By returning 0 we ensure that a join won't be processed more than once.
return 0;
}
sub Scheduled {
my $self = shift;
my ($event, @data) = @_;
my $what = shift(@data);
if ($what eq 'mode') {
$self->mode($event, @data);
} else {
# Call the inherited event
return $self->SUPER::Schedule(@_);
}
}

View File

@@ -1,143 +0,0 @@
################################
# Fortune Cookie Module #
################################
package BotModules::FortuneCookies;
use vars qw(@ISA);
@ISA = qw(BotModules);
1;
sub Help {
my $self = shift;
my ($event) = @_;
return {
'' => 'A module to get random fortune cookies.',
'fortune' => 'Same as \'cookie\', which see.',
'cookie' => 'To get a fortune cookie, just tell me \'cookie\'. To set a new fortune cookie, see \'new\' (or \'add\'). To find out how many cookies are left, use \'cookie status\'.',
'new' => 'To set a new fortune cookie, say \'new cookie\' followed by the text, e.g. \'new cookie: you will have a nice day\' or whatever. The string %from% will be replaced by the name of whoever requests the cookie.',
'add' => 'To add a new fortune cookie, say \'add cookie\' followed by the text, e.g. \'add cookie: you will have a nice day\' or whatever. The string %from% will be replaced by the name of whoever requests the cookie.',
'fetch' => 'The command \'fetch cookies from <uri>\' will add each line in <uri> to the cookie list. Cookie lists must start with one line that reads \'DATA FILE: cookies\' and must be at most 100 lines long. Blank lines and lines starting with a hash (\'#\') are ignored.',
};
}
# RegisterConfig - Called when initialised, should call registerVariables
sub RegisterConfig {
my $self = shift;
$self->SUPER::RegisterConfig(@_);
$self->registerVariables(
# [ name, save?, settable? ]
['cookies', 1, 1, ['The sun will rise in the east today, indicating nothing in particular.']],
['cookiesIndex', 1, 1, 0],
['cookiesLeft', 0, 1, 10],
['bakingTime', 1, 1, 20],
['cookiesMax', 1, 1, 10],
);
}
# Schedule - called when bot connects to a server, to install any schedulers
# use $self->schedule($event, $delay, $times, $data)
# where $times is 1 for a single event, -1 for recurring events,
# and a +ve number for an event that occurs that many times.
sub Schedule {
my $self = shift;
my ($event) = @_;
$self->schedule($event, \$self->{'bakingTime'}, -1, 'newCookie');
$self->SUPER::Schedule($event);
}
sub Told {
my $self = shift;
my ($event, $message) = @_;
if ($message =~ /^\s*(?:please[,.!1?]*\s+)?(?:(?:can|could)\s+i\s+have\s+a\s+|give\s+me\s+a\s+)?(?:fortune\s+cookie|fortune|cookie)(?:[,!1.\s]+now)?(?:[,!1.\s]+please)?\s*[?!1.]*\s*$/osi) {
if ($self->{'cookiesLeft'} > 0) {
$self->{'cookiesLeft'}--;
my $cookie = $self->GetNext('cookies');
$cookie =~ s/%from%/$event->{'from'}/gos;
$self->say($event, $cookie);
} else {
$self->say($event, 'I\'m sorry, I\'ve run out of cookies! You\'ll have to wait for me to bake some more.');
}
} elsif ($message =~ /^\s*(?:new|add)\s+(?:fortune\s+cookie|fortune|cookie)[-!:,;.\s]+(.....+?)\s*$/osi) {
if (not $self->findEntry('cookies', $1)) {
push(@{$self->{'cookies'}}, $1);
my $count = scalar(@{$self->{'cookies'}});
$self->say($event, "$event->{'from'}: Thanks! I have added that fortune cookie to my recipe book. I now have $count fortunes!");
$self->saveConfig();
} else {
$self->say($event, "$event->{'from'}: I'm pretty sure I already know that one.");
}
} elsif ($message =~ /^\s*cookie\s+(?:report|status|status\s+report)(?:\s+please)?[?!.1]*\s*$/osi) {
my $count = scalar(@{$self->{'cookies'}});
$self->say($event, "My cookie basket has $self->{'cookiesLeft'} cookies left out of possible $self->{'cookiesMax'}. I have $count fortunes in my recipe book.");
} elsif ($message =~ /^\s*fetch\s+cookies\s+from\s+(.+?)\s*$/osi) {
$self->getURI($event, $1, 'cookies');
} else {
return $self->SUPER::Told(@_);
}
return 0; # we've dealt with it, no need to do anything else.
}
sub GetNext {
my $self = shift;
my ($list) = @_;
$self->{"${list}Index"} = 0 if $self->{"${list}Index"} > $#{$self->{$list}};
my $reply = $self->{$list}->[$self->{"${list}Index"}++];
# should add some deterministic way of making the output appear more random here XXX
$self->saveConfig();
return $reply;
}
sub findEntry {
my $self = shift;
my ($list, $cookie) = @_;
$cookie =~ s/[\s,;.!?:]/_/gos;
$cookie = quotemeta($cookie);
$cookie =~ s/_/.*/gos;
my $regexp = qr/^$cookie$/is;
foreach my $text (@{$self->{$list}}) {
return 1 if $text =~ /$regexp/;
}
return 0;
}
sub Scheduled {
my $self = shift;
my ($event, @data) = @_;
if ($data[0] eq 'newCookie') {
$self->{'cookiesLeft'}++ unless $self->{'cookiesLeft'} >= $self->{'cookiesMax'};
} else {
$self->SUPER::Scheduled($event, @data);
}
}
sub GotURI {
my $self = shift;
my ($event, $uri, $output, $type) = @_;
if ($type eq 'cookies') {
my @output = split(/[\n\r]+/os, $output);
if ((@output) and ($output[0] eq "DATA FILE: $type")) {
if (@output <= 100) {
my $count = 0;
foreach (@output[1..$#output]) {
if (/^[^#].+$/os and length($_) < 255 and not $self->findEntry($type, $_)) {
push(@{$self->{$type}}, $_);
$count++;
}
}
my $total = scalar(@{$self->{$type}});
my $s = $count > 1 ? 's' : '';
if ($type eq 'cookies') {
$self->say($event, "$event->{'from'}: Thanks! I have added $count fortune cookie$s to my recipe book. I now have $total fortunes!");
}
$self->saveConfig();
} else {
$self->say($event, "$event->{'from'}: Sorry, but you can only import 100 lines at a time.");
}
} else {
$self->say($event, "$event->{'from'}: Sorry, but that's not a valid data file.");
}
} else {
return $self->SUPER::GotURI(@_);
}
}

View File

@@ -1,171 +0,0 @@
# -*- Mode: perl; tab-width: 4; indent-tabs-mode: nil; -*-
################################
# General Module #
################################
package BotModules::General;
use vars qw(@ISA);
@ISA = qw(BotModules);
1;
my $VERSION = '2.6';
# RegisterConfig - Called when initialised, should call registerVariables
sub RegisterConfig {
my $self = shift;
$self->SUPER::RegisterConfig(@_);
$self->registerVariables(
# [ name, save?, settable?, value ]
['preferredHelpLineLength', 1, 1, 90],
['helpStyle', 1, 1, 'compact'], # change this to 'tidy' to use alternate style
);
}
sub Help {
my $self = shift;
my ($event) = @_;
return {
'' => 'The module that provides the bot-wide services.',
'help' => 'Gives information about modules and commands. Syntax: help [<topic>]',
'shutup' => 'Tells the bot to stop talking to you. Syntax: shut up',
};
}
# Told - Called for messages prefixed by the bot's nick
sub Told {
my $self = shift;
my ($event, $message) = @_;
if ($message =~ /^\s*(?:help|commands?)(?:\s+($variablepattern))?[ ?!.]*\s*$/osi) {
if ($1) {
# display help for that command
# first, build the help file...
my %topicList;
foreach my $module (@modules) {
my $commands;
eval {
$commands = $module->Help($event);
};
if ($@) {
$self->debug("Module $module is having errors reporting help:\n$@");
next;
}
if ($commands->{''}) {
my @commands = grep { /./os } keys %$commands;
$topicList{lc($module->{'_name'})} = [] unless defined($topicList{lc($module->{'_name'})});
push(@{$topicList{lc($module->{'_name'})}}, $commands->{''});
if (@commands) {
local $" = ', ';
push(@{$topicList{lc($module->{'_name'})}}, "The $module->{'_name'} module has the following help topics: @commands");
}
}
foreach (keys %$commands) {
$topicList{lc($_)} = [] unless defined($topicList{lc($_)});
push(@{$topicList{lc($_)}}, $commands->{$_});
}
}
if (defined($topicList{lc($1)})) {
foreach (@{$topicList{lc($1)}}) {
$self->say($event, "$1: $_");
}
} else {
$self->say($event, "No help for topic '$1'.");
}
} else {
my $helpline = $self->getHelpLine();
$self->directSay($event, "Help topics for mozbot $VERSION ($helpline):");
$self->say($event, "$event->{'from'}: help info /msg'ed") if ($event->{'channel'});
if ($self->{'helpStyle'} eq 'compact') {
$self->printHelpCompact($event);
} else {
$self->printHelpTidy($event);
}
$self->directSay($event, 'For help on a particular topic, type \'help <topic>\'. Note that some commands may be disabled in certain channels.');
}
} elsif ($message =~ /^\s*shut\s*up\s*$/osi) {
my $queue = $self->getMessageQueue();
my @messages = @$queue;
@$queue = ();
my $count = 0;
if ($event->{'channel'}) {
foreach my $message (@messages) {
if ($message->[0] eq $event->{'channel'} and
ref $message->[1] eq 'SCALAR' and
$message->[1] =~ m/^\Q$event->{'from'}\E:/osi) {
++$count;
} else {
push(@$queue, $message);
}
}
} else {
foreach my $message (@messages) {
if (lc $message->[0] eq lc $event->{'from'}) {
++$count;
} else {
push(@$queue, $message);
}
}
}
if ($count) {
$self->say($event, "$event->{'from'}: Dropped $count messages.");
} else {
$self->say($event, "$event->{'from'}: I wasn't talking to you.");
}
} else {
return $self->SUPER::Told(@_);
}
return 0; # dealt with it, do nothing else
}
sub CTCPVersion {
my $self = shift;
my ($event, $who, $what) = @_;
my @modulenames = $self->getModules();
local $" = ', ';
$self->ctcpReply($event, 'VERSION', "mozbot $VERSION (@modulenames)");
}
sub printHelpCompact {
my $self = shift;
my ($event) = @_;
local $" = ', '; # to reset font-lock: "
my @helplist;
foreach my $module ($self->getModules()) {
$module = $self->getModule($module);
my %commands = %{$module->Help($event)};
my $moduleHelp = delete($commands{''});
my @commands = sort keys %commands;
if (@commands) {
push(@helplist, "$module->{'_name'}: @commands");
} elsif ($moduleHelp) {
push(@helplist, "$module->{'_name'}");
}
}
foreach ($self->prettyPrint($self->{'preferredHelpLineLength'}, undef, ' ', '; ', @helplist)) {
$self->directSay($event, $_);
}
}
sub printHelpTidy {
my $self = shift;
my ($event) = @_;
my @modules = sort $self->getModules();
my $longestTitle = 0;
foreach my $module (@modules) {
$longestTitle = length($module) if length($module) > $longestTitle;
$module = [$module, sort keys %{$self->getModule($module)->Help($event)}];
}
foreach my $module (@modules) {
my $title = shift(@$module);
my $topicCount = @$module;
if (@$module and $module->[0] eq '') {
shift(@$module);
}
my @topics = @$module;
$module = ' ' x ($longestTitle - length($title)) . $title;
if (@topics) {
$self->directSay($event, $module . ': ' . join(",\n" . ' ' x ($longestTitle + 2), $self->wordWrap($self->{'preferredHelpLineLength'} - $longestTitle - 2, undef, undef, ', ', @topics)));
} elsif ($topicCount) {
$self->directSay($event, "$module: (no commands)");
}
}
}

View File

@@ -1,341 +0,0 @@
# -*- Mode: perl; indent-tabs-mode: nil -*-
################################
# God Module #
################################
package BotModules::God;
use vars qw(@ISA);
@ISA = qw(BotModules);
1;
# XXX should also do autovoice
sub Help {
my $self = shift;
my ($event) = @_;
my $answer = {
'' => 'A per-channel auto-opper.',
'ops' => 'Lists the autoop list for a channel. Syntax: \'ops in <channel>\'',
'opme' => 'Checks the autoop list, and ops the speaker if they are on the autoop list. Must be used in a channel. Syntax: \'op me\' or \'opme\'',
'mask' => 'Add or remove a regexp mask from a channel\'s autoop list. Only bot and channel admins can do this. USE OF THIS FEATURE IS HIGHLY DISCOURAGED AS IT IS VERY INSECURE!!! Syntax: \'add mask <user@host> in <channel>\' to add and \'remove mask <user@host> in <channel>\' to remove. The special word \'everywhere\' can be used instead of a channel name to add a mask that works in all channels.',
'autoop' => 'Add someone to the autoop list for a channel. Only bot and channel admins can do this. Syntax: \'autoop <user> in <channel>\'',
'deautoop' => 'Remove someone from the autoop list for a channel. Only bot and channel admins can do this. Syntax: \'deautoop <user> in <channel>\'',
'enable' => 'Enable a module in a channel. Only bot and channel admins can do this. Syntax: \'enable <module> in <channel>\'',
'disable' => 'Disable a module in a channel. Only bot and channel admins can do this. Syntax: \'disable <module> in <channel>\'',
};
if ($self->isAdmin($event)) {
$answer->{'opme'} .= '. As an administrator, you can also say \'op me in <channel>\' or \'op me everywhere\' which will do the obvious things.';
$answer->{'promote'} = 'Add someone to the channel admin list for a channel. Only bot admins can do this. Syntax: \'promote <user> in <channel>\'',
$answer->{'demote'} = 'Remove someone from the channel admin list for a channel. Only bot admins can do this. Syntax: \'demote <user> in <channel>\'',
}
return $answer;
}
# RegisterConfig - Called when initialised, should call registerVariables
sub RegisterConfig {
my $self = shift;
$self->SUPER::RegisterConfig(@_);
$self->registerVariables(
# [ name, save?, settable? ]
['channelAdmins', 1, 1, {}],
['channelOps', 1, 1, {}],
['channelOpMasks', 1, 1, {}],
['kickLog', 1, 1, []],
['allowPrivateOpRequests', 1, 1, 1],
['maxInChannel', 1, 1, 4],
);
}
sub Told {
my $self = shift;
my ($event, $message) = @_;
if ($event->{'level'} == 1) {
if ($message =~ /^\s*(?:list\s+)?ops\s+(?:in\s+|for\s+)?(\S+)\s*\??$/osi) {
my $channel = lc($1);
$self->listOps($event, $channel);
} elsif ($message =~ /^\s*autoop\s+(\S+)\s+in\s+(\S+)\s*$/osi) {
if (($self->isChannelAdmin($event, $2)) or ($self->isAdmin($event))) {
my $channel = $2 eq 'everywhere' ? '' : lc($2);
$self->{'channelOps'}->{$channel} .= " $1";
$self->saveConfig();
$self->say($event, "$event->{'from'}: User '$1' added to the autoop list of channel '$2'.");
} else {
$self->say($event, "$event->{'from'}: Only channel administrators may add people to a channel's autoop list.");
}
} elsif ($message =~ /^\s*deautoop\s+(\S+)\s+in\s+(\S+)\s*$/osi) {
if (($self->isChannelAdmin($event, $2)) or ($self->isAdmin($event))) {
my $channel = $2 eq 'everywhere' ? '' : lc($2);
my %people = map { $_ => 1 } split(/ +/os, $self->{'channelOps'}->{$channel});
delete($people{$1}); # get rid of any mentions of that person
$self->{'channelOps'}->{$channel} = join(' ', keys(%people));
$self->saveConfig();
$self->say($event, "$event->{'from'}: User '$1' removed from the autoop list of channel '$2'.");
} else {
$self->say($event, "$event->{'from'}: Only channel administrators may remove people from a channel's autoop list.");
}
} elsif ($message =~ /^\s*add\s+mask\s+(\S+)\s+(?:in|to|for|from)\s+(\S+)\s*$/osi) {
if (($self->isChannelAdmin($event, $2)) or ($self->isAdmin($event))) {
my $channel = $2 eq 'everywhere' ? '' : lc($2);
$self->{'channelOpMasks'}->{$channel} .= " $1";
$self->saveConfig();
$self->say($event, "$event->{'from'}: Mask '$1' added to the autoop list of channel '$2'.");
} else {
$self->say($event, "$event->{'from'}: Only channel administrators may add masks to a channel's autoop list.");
}
} elsif ($message =~ /^\s*remove\s+mask\s+(\S+)\s+(?:in|from|for|to)\s+(\S+)\s*$/osi) {
if (($self->isChannelAdmin($event, $2)) or ($self->isAdmin($event))) {
my $channel = $2 eq 'everywhere' ? '' : lc($2);
my %people = map { $_ => 1 } split(/ +/os, $self->{'channelOpMasks'}->{$channel});
delete($people{$1}); # get rid of any mentions of that person
$self->{'channelOpMasks'}->{$channel} = join(' ', keys(%people));
$self->saveConfig();
$self->say($event, "$event->{'from'}: Mask '$1' removed from the autoop list of channel '$2'.");
} else {
$self->say($event, "$event->{'from'}: Only channel administrators may remove masks from a channel's autoop list.");
}
} elsif ($message =~ /^\s*promote\s+(\S+)\s+in\s+(\S+)\s*$/osi) {
if ($self->isAdmin($event)) {
$self->{'channelAdmins'}->{lc($2)} .= " $1";
$self->saveConfig();
$self->say($event, "$event->{'from'}: User '$1' promoted to channel administrator status in channel '$2'.");
} else {
$self->say($event, "$event->{'from'}: Only administrators may promote people to channel admin status.");
}
} elsif ($message =~ /^\s*demote\s+(\S+)\s+in\s+(\S+)\s*$/osi) {
if ($self->isAdmin($event)) {
my %people = map { $_ => 1 } split(/ +/os, $self->{'channelAdmins'}->{lc($2)});
delete($people{$1}); # get rid of any mentions of that person
$self->{'channelAdmins'}->{lc($2)} = join(' ', keys(%people));
$self->saveConfig();
$self->say($event, "$event->{'from'}: User '$1' removed from the channel administrator list of channel '$2'.");
} else {
$self->say($event, "$event->{'from'}: Only administrators may remove people's channel admin status.");
}
} elsif ($message =~ /^\s*enable\s+(\S+)\s+in\s+(\S+)\s*$/osi) {
if (($self->isAdmin($event)) or ($self->isChannelAdmin($event, $2))) {
my $module = $self->getModule($1);
if ($1) {
push(@{$module->{'channels'}}, lc($2));
$module->saveConfig();
$self->say($event, "$event->{'from'}: Module '$1' enabled in channel '$2'.");
} else {
$self->say($event, "$event->{'from'}: There is no module called '$1', sorry.");
}
} else {
$self->say($event, "$event->{'from'}: Only channel administrators may change a module's status.");
}
} elsif ($message =~ /^\s*disable\s+(\S+)\s+in\s+(\S+)\s*$/osi) {
if (($self->isAdmin($event)) or ($self->isChannelAdmin($event, $2))) {
my $module = $self->getModule($1);
if ($1) {
my %channels = map { $_ => 1 } @{$module->{'channels'}};
delete($channels{lc($2)}); # get rid of any mentions of that channel
@{$module->{'channels'}} = keys %channels;
$module->saveConfig();
$self->say($event, "$event->{'from'}: Module '$1' disabled in channel '$2'.");
} else {
$self->say($event, "$event->{'from'}: There is no module called '$1', sorry.");
}
} else {
$self->say($event, "$event->{'from'}: Only channel administrators may change a module's status.");
}
} elsif ($message =~ /^\s*(?:(?:(?:de)?autoop|promote|demote|enable|disable|add\s+mask|remove\s+mask)\s+(\S+)|(?:list\s+)?ops)\s*$/osi) {
$self->say($event, "$event->{'from'}: You have to give a channel, as in \'<command> <who> in <channel>\'.");
# XXX next two could be merged, maybe.
} elsif ($message =~ /^\s*op\s*meh?[!1.,\s]*(?:now\s+)?(?:please|(b+[iea]+t+c+h+))?\s*[.!1]*\s*$/osi) {
if ($event->{'channel'}) {
if ($event->{'userName'}) {
unless ($self->checkOpping($event, $event->{'channel'}, $event->{'from'}, $self->isAdmin($event))) {
if ($1) { # only true if they said bitch
$self->say($event, "$event->{'from'}: No way, beetch!");
} else {
$self->say($event, "$event->{'from'}: Sorry, you are not on my auto-op list.");
}
}
} else {
unless ($self->isMatchedByMask($event, $event->{'channel'}) and
$self->checkOpping($event, $event->{'channel'}, $event->{'from'})) {
$self->say($event, "$event->{'from'}: You haven't authenticated yet. See 'help auth' for details.");
}
}
} else {
$self->say($event, "$event->{'from'}: You have to use this command in public.");
}
} elsif ($message =~ /^\s*(?:please\s+)?op\s*me(?:\s+in\s+(\S+)|\s+everywhere)?[\s!1.]*\s*$/osi) {
if (($self->{'allowPrivateOpRequests'}) or ($self->isAdmin($event))) {
if ($1) {
$self->checkOpping($event, lc($1), $event->{'from'}, $self->isAdmin($event));
} else {
foreach (@{$self->{'channels'}}) {
$self->checkOpping($event, $_, $event->{'from'}, $self->isAdmin($event));
}
}
} else {
$self->say($event, "$event->{'from'}: Sorry, but no. Try \'help opme\' for details on commansyntax.");
}
} else {
my $parentResult = $self->SUPER::Told(@_);
return $parentResult < 2 ? 2 : $parentResult;
}
return 0; # we've dealt with it, no need to do anything ese.
} elsif ($event->{'level'} == 2) {
if (defined($event->{'God_channel'})) {
$event->{'God_channel_rights'} = $self->isChannelAdmin($event, $event->{'God_channel'});
}
}
return $self->SUPER::Told(@_);
}
# SpottedJoin - Called when someone joins a channel
sub SpottedJoin {
my $self = shift;
my ($event, $channel, $who) = @_;
$self->checkOpping(@_, 0);
return $self->SUPER::SpottedJoin(@_); # this should not stop anything else happening
}
# do all channels when someone authenticates
sub Authed {
my $self = shift;
my ($event, $who) = @_;
foreach (@{$self->{'channels'}}) {
$self->checkOpping($event, $_, $who, 0);
}
return $self->SUPER::Authed(@_); # this should not stop anything else happening
}
# check is someone is in the opping.
sub checkOpping {
my $self = shift;
my ($event, $channel, $who, $override) = @_;
if (($self->isAutoopped($event, $channel)) or ($self->isChannelAdmin($event, $channel)) or ($override)) {
$self->mode($event, $channel, '+o', $who);
return 1;
}
return 0;
}
sub isChannelAdmin {
my $self = shift;
my ($event, $channel) = @_;
return (($event->{'userName'}) and
(defined($self->{'channelAdmins'}->{$channel})) and
($self->{'channelAdmins'}->{$channel} =~ /^(|.*\s+)$event->{'userName'}(\s+.*|)$/s));
}
sub isAutoopped {
my $self = shift;
my ($event, $channel) = @_;
return ((($event->{'userName'}) and
(defined($self->{'channelOps'}->{$channel})) and
(($self->{'channelOps'}->{$channel} =~ /^(|.*\s+)$event->{'userName'}(\s+.*|)$/s) or
($self->{'channelOps'}->{''} =~ /^(|.*\s+)$event->{'userName'}(\s+.*|)$/s))) or
($self->isMatchedByMask($event, $channel)));
}
# grrrr -- this insecure feature is here by popular demand
sub isMatchedByMask {
my $self = shift;
my ($event, $channel) = @_;
my $masks;
$masks .= $self->{'channelOpMasks'}->{$channel} if defined($self->{'channelOpMasks'}->{$channel});
$masks .= ' '.$self->{'channelOpMasks'}->{''} if defined($self->{'channelOpMasks'}->{''});
if (defined($masks)) {
my @masks = split(/ +/os, $masks);
my $user = $event->{'user'};
foreach my $regexp (@masks) {
my $pattern;
if ($regexp =~ m/ ^ # start at the start
([^!@]+) # nick part
\! # nick-username delimiter
([^!@]+) # username part
\@ # username-host delimiter
([^!@]+) # host part
$ # end at the end
/osx) {
my $nick = $1;
my $user = $2;
my $host = $3;
# This was entered as an IRC hostmask so we need to
# translate it into a regular expression.
foreach ($nick, $user, $host) {
$_ = quotemeta($_); # escape regular expression magic
s/\\\*/.*/gos; # translate "*" into regexp equivalent
}
# If we don't match the first part of the host-mask
# (the user's nick) then we should not op them; we
# should just skip to the next mask.
next unless $event->{'from'} =~ m/^$nick$/i;
# ok, create hostmask regexp
$pattern = "^$user\@$host\$";
} else {
# this was entered as a regexp, check it is valid.
$pattern = $self->sanitizeRegexp($regexp);
}
if (($pattern =~ /[^\s.*+]/os) # pattern is non-trivial
and ($user =~ /$pattern/si)) { # pattern matches user
return 1; # op user (so insecure, sigh)
}
}
}
return 0;
}
sub Kicked {
my $self = shift;
my ($event, $channel) = @_;
push(@{$self->{'kickLog'}}, "$event->{'from'} kicked us from $channel"); # XXX karma or something... ;-)
return $self->SUPER::Kicked(@_);
}
sub getList {
my $self = shift;
my ($channel, $list) = @_;
my $data;
my @list;
$data = defined($self->{$list}->{$channel}) ? $self->{$list}->{$channel} : '';
$data .= defined($self->{$list}->{''}) ? ' '.$self->{$list}->{''} : '';
if ($data =~ /^\s*$/os) {
@list = ('(none)');
} else {
@list = sort(split(/\s+/os, $data));
while ((@list) and ($list[0] =~ /^\s*$/)) { shift @list; }
}
return @list;
}
sub listOps {
my $self = shift;
my ($event, $channel) = @_;
my @admins = $self->getList($channel, 'channelAdmins');
my @ops = $self->getList($channel, 'channelOps');
my @masks = $self->getList($channel, 'channelOpMasks');
local $" = ' ';
my @output = ();
push(@output, "$channel admins: @admins");
push(@output, "$channel ops: @ops");
if (@masks > 2) {
push(@output, "$channel autoop masks:");
foreach (@masks) {
push(@output, " $_");
}
} else {
push(@output, "$channel autoop masks: @masks");
}
if (scalar(@output) > $self->{'maxInChannel'}) {
foreach (@output) {
$self->directSay($event, $_);
}
$self->channelSay($event, "$event->{'from'}: long list /msg'ed");
} else {
foreach (@output) {
$self->say($event, "$event->{'from'}: $_");
}
}
}

View File

@@ -1,150 +0,0 @@
################################
# Google Module #
################################
# Original Author: Max Kanat-Alexander <mkanat@bugzilla.org>
# Author: Stephen Lau <steve@grommit.com>
#
# stevel's notes:
# The original version of this module used Net::Google which used the Google
# SOAP API. I've updated it to use the REST::Google::Search module which
# uses Google's AJAX API
#
# This API requires that you send a valid HTTP_REFERER, which you can set
# with the REFERER constant below:
package BotModules::Google;
use vars qw(@ISA);
@ISA = qw(BotModules);
use REST::Google::Search;
use constant SEPARATOR => ' -- ';
use constant REFERER => 'http://www.mozilla.org/projects/mozbot/';
1;
sub Help {
my $self = shift;
my ($event) = @_;
return {
'' => q{Queries Google for specified search terms. },
'google' => q{Searches google for the specified terms.}
. q{Syntax: 'google <terms>'},
'fight' => q{Google fight two terms.}
. q{Syntax: 'fight <term1> vs. <term2>'}
};
}
# RegisterConfig - Called when initialised, should call registerVariables
sub RegisterConfig {
my $self = shift;
$self->SUPER::RegisterConfig(@_);
$self->registerVariables(
# [ name, save?, settable? ]
['maxResults', 1, 1, 8],
['maxInChannel', 1, 1, 1],
['safeSearch', 1, 1, 1],
['maxLineLength', 1, 1, 256]
);
}
sub Told {
my $self = shift;
my ($event, $message) = @_;
# We take anything that occurs at the end of the line,
# because Google will ignore punctuation anyway.
if ($message =~ /^(\s*google\s+)(.+)$/osi) {
my $terms = $2;
my @searchResults = $self->doSearch($terms);
if (!@searchResults) {
$self->say($event, "Nothing found.");
}
# If we are in a channel, and not a /msg
elsif ($event->{'channel'}) {
splice(@searchResults, $self->{'maxInChannel'});
}
# We're in a /msg
else {
unshift(@searchResults, scalar(@searchResults) . " results found: ");
}
foreach my $result (@searchResults) {
$self->say($event, $event->{'from'} . ': ' . $result);
}
} elsif ($message =~ /^(\s*fight\s+)(.+)\s+vs\.\s+(.+)\s*$/osi) {
my $term1 = $2;
my $term2 = $3;
my $results1 = $self->getNumResults($term1);
my $results2 = $self->getNumResults($term2);
if ($results1 > $results2) {
$self->say($event, "$term1 beats $term2, $results1 to $results2!");
} elsif ($results2 > $results1) {
$self->say($event, "$term2 beats $term1, $results2 to $results1!");
} else {
$self->say($event, "It's a dead tie at $results1 results!");
}
} else {
return $self->SUPER::Told(@_);
}
return 0; # we've dealt with it, no need to do anything else.
}
sub getNumResults {
my $self = shift;
my ($terms) = @_;
REST::Google::Search->http_referer(REFERER);
my $res = REST::Google::Search->new(
q => $terms,
rsz => "large",
);
if ($res->responseStatus != 200) {
return 0;
}
my $data = $res->responseData;
return $data->cursor->estimatedResultCount;
}
# Performs the actual Google search and returns the
# result as an array of lines to say.
sub doSearch {
my $self = shift;
my ($terms) = @_;
my @searchLines = ();
REST::Google::Search->http_referer(REFERER);
my $res = REST::Google::Search->new(
q => $terms,
rsz => "large",
);
if ($res->responseStatus != 200) {
return @searchLines;
}
my $data = $res->responseData;
my @results = $data->results;
foreach my $result (@results) {
my $title = $result->title;
# The Google API puts <b></b> tags into the title if the search
# terms appear in the title.
$title =~ s|</?b>||g;
$title = $self->unescapeXML($title);
my $url = $result->url;
my $line_size = (length($title) + length($result) + length(SEPARATOR));
if ($line_size > $self->{'maxLineLength'} ) {
# The 3 is for the '...'
my $new_title_size = ($line_size - $self->{'maxLineLength'}) - 3;
my $title = substr($title, 0, $new_title_size)
. '...';
}
my $resultLine = $title . SEPARATOR . $url;
push(@searchLines, $resultLine);
}
return @searchLines;
}

View File

@@ -1,361 +0,0 @@
# -*- Mode: perl; tab-width: 4; indent-tabs-mode: nil; -*-
################################
# Greeting Module #
################################
package BotModules::Greeting;
use vars qw(@ISA);
@ISA = qw(BotModules);
1;
sub Help {
my $self = shift;
my ($event) = @_;
return {
'' => 'A polite module for saying hello and goodbye and so on.',
'hi' => 'To greet the bot.',
'bye' => 'To say goodbye to the bot.',
'ping' => 'To check the bot is alive.',
'status' => 'Gives the amount of time that the bot has been active.',
};
}
# RegisterConfig - Called when initialised, should call registerVariables
sub RegisterConfig {
my $self = shift;
$self->SUPER::RegisterConfig(@_);
$self->registerVariables(
# [ name, save?, settable? ]
['greetings', 1, 1, ['hi %', 'yo %', 'salut %', '%! dude!', '%: hello', '%', 'bonjour %', 'g\'day mate']],
['greetingsIndex', 1, 1, 0],
['byes', 1, 1, ['seeya %', 'bye %', 'night %', '/me waves goodbye to %']],
['byesIndex', 1, 1, 0],
['ow', 1, 1, ['%!! stop it!!', '%? You want something?', 'I\'m working! Leave me alone!', 'ow!', 'Leave me out of it!', '%: mean!']],
['owIndex', 1, 1, 0],
['veryow', 1, 1, ['OOOOWWWW!!!', 'GETOFF!!!', '/me fights back', 'Yikes! I\'m being attacked!!', '/me hits % over the head with a 2-by-4']],
['veryowIndex', 1, 1, 0],
['hit', 1, 1, ['/me smacks %target', '/me hits %target over the head with a hammer', '/me trips %target up and laughs', '%target! look over there! *smack*', '/me pokes %target in the ribs']],
['hitIndex', 1, 1, 0],
['hitProtected', 1, 1, {'hixie' => '%target: %source wanted me to hurt you but don\'t worry, i wuv you, i\'d never hurt you...', 'me' => '/me wacks %source in the legs with a crowbar', '' => '%source: Oh you\'d like that, wouldn\'t you, you sadist pervert.', 'yourself' => 'hey look everyone! %source likes to see others hurt themselves!', 'urself' => 'oh my! %source can\'t even spell! It\'s written "yourself", moron!'}],
['hitEnabled', 1, 1, 1], # set to 0 to disable hitting
['pat', 1, 1, ['/me patpats %target', '%target: yes dear, *pat* *pat*', '/me pats %target condescendingly', '%target: *pat* *pat*']],
['patIndex', 1, 1, 0],
['patProtected', 1, 1, {'' => '%source: what did I do now?', 'yourself' => '%source: why? what did i do wrong?'}],
['hug', 1, 1, ['/me hugs %target', '%target: *hug*', '/me hugs %target lovingly', '%target: come \'ere! *hugs and kisses*']],
['hugIndex', 1, 1, 0],
['yousuck', 1, 1, ['%: no, *you* suck!', '/me pouts', '/me cries', '/me . o O ( now what have i done... )']],
['yousuckIndex', 1, 1, 0],
['thanks', 1, 1, ['sure thing %', 'np', '%: np', '%: just doing my job!']],
['thanksIndex', 1, 1, 0],
['listen', 1, 1, ['(*', '%: I\'m listening.', '%?']],
['listenIndex', 1, 1, 0],
['happy', 1, 1, [':)', '/me smiles', 'yay', '/me beams']],
['happyIndex', 1, 1, 0],
['unhappy', 1, 1, [':(', '/me sobs', '/me cries', '*sniff*', 'but... but...', '/me is all sad']],
['unhappyIndex', 1, 1, 0],
['vhappy', 1, 1, ['OOoh! %!', 'I love you too, %.']],
['vhappyIndex', 1, 1, 0],
['kinky', 1, 1, ['eep!', 'me-ow!', 'oh yeah! spank me baby!', '/me tickles %', 'he-llo, baby!']],
['kinkyIndex', 1, 1, 0],
['tickle', 1, 1, ['eep!', 'iiiih!', 'meep!', '/me tickles % back', 'yelp!']],
['tickleIndex', 1, 1, 0],
['apology', 1, 1, ['Apology accepted.', 'thanks', 's\'ok', 'heh', 'that\'s ok']],
['apologyIndex', 1, 1, 0],
['whoami', 1, 1, 'I am a bot. /msg me the word \'help\' for a list of commands.'],
['lastrheet', 0, 0, 0], # time of last rheet
['rheetbuffer', 1, 1, 10], # max of 1 rheet per this many seconds
['rheetMaxEs', 1, 1, 100], # number of es at which to stop responding.
['autoGreetMute', 1, 1, []], # channels to mute in
['autoGreetings', 1, 1, {}], # people to greet and their greeting
['autoGreeted', 0, 0, {}], # people to NOT greet, and the last time
['autoGreetedBackoffTime', 1, 1, 20], # how long to not greet people (seconds)
['evil', 1, 1, ['c++ is evil', '/me mumbles something about c++ being evil', 'c++ is e-- ah, nevermind.', 'c++ sucks', '/me frowns at %']],
['evilIndex', 1, 1, 0],
['evilBackoffTime', 1, 1, 36000], # how long to not insult c++ (10 hours by default)
['evilMute', 1, 1, []], # channels to disable evil in, * for all channels
['lastEvil', 1, 0, 0], # when the last c++ insult took place
['assumeThanksTime', 1, 1, 10], # how long to assume that thanks are directed to us after hearing from them (seconds)
['_lastSpoken', 0, 0, {}], # who has spoken to us
['source', 1, 1, 'http://lxr.mozilla.org/mozilla/source/webtools/mozbot/'], # reply to give for CTCP SOURCE
);
}
sub Told {
my $self = shift;
my ($event, $message) = @_;
my $now = $event->{'time'};
$self->{'_lastSpoken'}->{$event->{'user'}} = $now;
my $me = quotemeta($event->{'bot'}->nick);
my $expandedme = join('+', split(//gos, $me)).'+';
if ($message =~ /^\s*(?:(?:g[ood\']*\s*)?(?:mornin[g\']?|evenin[g\']?|afternoon|day)|hi|heya?|bonjour|hoi|w+a+[sz]+u+p+\?*|hello|lo|wb|welcome\s+back|greetings|yo(?:\s+yo)*(?:\s+du+de)?|m+[ayh]+(?:\s+m+a+i+n+)?\s+m+a+n+|d+u+d+e+)[?!1.\s]*(?::-?[\)Pp]\s*)*$/osi) {
if ($self->canGreet($event)) {
$self->Perform($event, 'greetings');
}
} elsif ($message =~ /^\s*(?:bye|(?:g?'?|good\s+)night|seeya|ciao)[?!1.\s]*$/osi) {
$self->Perform($event, 'byes');
} elsif ($message =~ /^\s*say[\s:,\"\']+(hi|hello|lo|good\s*bye|seeya)(?:\s+to\s+(\S+))(?:[,\s]*please)?[?!1.\s]*$/osi) {
if ($2) {
$self->say($event, "$2: $1");
} else {
$self->say($event, "$1");
}
} elsif ($message =~ /^\s*
(?: (?:you|u) \s+
(?:really\s+)?
suck
(?: \s+hard
| (?:\s+big)? \s+ rocks)?
| (?:you|u) \s+
(?:smell|stick)
| (?:you|u)
(?:\s+are|\s+r|'re|r) \s+
(?:an?\s+)?
(?:really\s+)*
(?:idiot|stupid|dumb|moron|moronic|useless)
(?:\s+bot)?
| i \s+ hate \s+ (?:you|u)
| bi+tch)
[?!1.\s]*$/osix) {
$self->Perform($event, 'yousuck');
} elsif ($message =~ /^\s*(?:oh[!1?.,\s]*)?(?:thanks|thank\s+you|cheers)[\s!1.]*(?:[;:8][-o]?[]()\|O0<>[]\s*)?$/osi) {
$self->Perform($event, 'thanks');
} elsif ($message =~ /^\s*(?:good\s+bot[.!1\s]*|(?:you|u)\s+rock(?:\s+bot)?|:-?\)|(?:have\s+a\s+)?bot\s*snack[.!1\s]*)\s*(?:[;:8][-o]?[]()\|O0<>[]\s*)?$/osi) {
$self->Perform($event, 'happy');
} elsif ($message =~ /^\s*(?:i|we)\s+love\s+(?:you|u)[.!1\s]*(?:[;:8][-o]?[]()\|O0<>[]\s*)?$/osi) {
$self->Perform($event, 'happy');
} elsif ($message =~ /^\s*(?:please[\s,.]+)?(?:(?:would|will)\s+you\s+)?(?:hit|kick|slap|smack)\s+(\S+?)(?:[\s,.]+please)?[.!?\s]*\s*$/osi) {
if ($self->{'hitEnabled'}) {
$self->PerformOnOther($event, 'hit', $1);
}
} elsif ($message =~ /^\s*(?:please[\s,.]+)?(?:(?:would|will)\s+you\s+)?(?:pat|pat\s*pat)\s+(\S+?)(?:[\s,.]+please)?[.!?\s]*\s*$/osi) {
$self->PerformOnOther($event, 'pat', $1);
} elsif ($message =~ /^\s*(?:please[\s,.]+)?(?:(?:would|will)\s+you\s+)?(?:hug)\s+(\S+?)(?:[\s,.]+please)?[.!?\s]*\s*$/osi) {
$self->PerformOnOther($event, 'hug', $1);
} elsif ($message =~ /^\s*(?:useless|die|get\s+a\s+life|kiss\s+my\s+ass|you\s+stupid\s+piece\s+o[f']?\s+code)[!1.\s]*$/osi) {
$self->Perform($event, 'unhappy');
} elsif ($message =~ /^\s*sorry\b/osi) { # note that any trailing text is ignored
$self->Perform($event, 'apology');
} elsif ($message =~ /^\s*(?:how\s+are\s+you|how\s+do\s+you\s+do|how\'?s\s+things|are\s+you\s+ok)(?:[?!1.,\s]+$expandedme)?\s*[?!1.\s]*$/osi) {
$uptime = $self->days($^T);
$self->say($event, "$event->{'from'}: fine thanks! I've been up $uptime so far!");
} elsif ($message =~ /^\s*(?:who\s+are\s+you)\s*[?!1.\s]*$/osi) {
$self->say($event, "$event->{'from'}: $self->{'whoami'}");
} elsif ($message =~ /^\s*(?:up\s*(?:time)|status)[?!1.\s]*$/osi) {
$uptime = $self->days($^T);
$self->say($event, "$event->{'from'}: I've been up $uptime.");
} elsif ($message =~ /^\s*r+h+e(e+)t+[!1.\s]*$/osi) {
if (length($1) < $self->{'rheetMaxEs'}) {
$self->say($event, "$event->{'from'}: rhe$1$1t!");
} else {
$self->say($event, "$event->{'from'}: uh, whatever.");
}
} elsif ($message =~ /^\s*ping\s*$/osi) {
$self->say($event, "$event->{'from'}: pong");
} else {
return $self->SUPER::Told(@_);
}
return 0; # we've dealt with it, no need to do anything else.
}
sub Heard {
my $self = shift;
my ($event, $message) = @_;
my $me = quotemeta($event->{'bot'}->nick);
my $expandedme = join('+', split(//gos, $me)).'+';
if ($message =~ /^\s*(?:(?:(?:(?:g[ood\']*\s*)?(?:mornin[g\']?|evenin[g\']?|afternoon|day)|hi|heya?|bonjour|hoi|w+a+[sz]+u+p+|hello|lo|wb|welcome\s+back|greetings|yo(?:\s+yo)*)\s+)?$expandedme[!1\s]*|o+h[\s,.!?]+look[\s,.!?]+a\s+$me[\s.!1]*)(?::-?[\)Pp]\s*)*$/si) {
if ($self->canGreet($event)) {
$self->Perform($event, 'greetings');
}
} elsif ($message =~ /^\s*(?:bye|(?:g?\'?|good\s+)night|seeya|ciao)\s+$me[!1.\s]*$/si) {
$self->Perform($event, 'byes');
} elsif ($message =~ /^\s*(?:oh[!1?,.\s]*)?(?:thanks|thank\s*you|cheers)\s+$me[\s!1.]*(?:[;:8][-o]?[]()\|O0<>[]\s*)?$/si) {
$self->Perform($event, 'thanks');
} elsif (($message =~ /^\s*(?:oh[!1?,.\s]*)?(?:thanks|thank\s*you|cheers)[\s!1.]*(?:[;:8][-o]?[]()\|O0<>[]\s*)?$/osi) and ($self->canAssumeThanks($event))) {
$self->Perform($event, 'thanks');
} elsif (($message =~ /^\s*(?:good\s+bot)[!1.\s]*(?:[;:8][-o]?[]()\|O0<>[]\s*)?$/osi) and ($self->canAssumeThanks($event))) {
$self->Perform($event, 'happy');
} elsif (($message =~ /^\s*(?:bad|foo[l\']?|idiot|dumb|useless|moron|moronic)(?:\s+bot)?[!.\s]*?$/osi) and ($self->canAssumeThanks($event))) {
$self->Perform($event, 'unhappy');
} elsif (($message =~ /^\s*bad\s*$me[!.\s]*$/si) and ($self->canAssumeThanks($event))) {
$self->Perform($event, 'unhappy');
} elsif (($message =~ /^\s*
(?: (?:you|u) \s+
(?:really\s+)?
suck
(?: \s+hard
| (?:\s+big)? \s+ rocks)?
| (?:you|u) \s+
(?:smell|stick)
| (?:you|u)
(?:\s+are|\s+r|'re|r) \s+
(?:an?\s+)?
(?:really\s+)?
(?:idiot|stupid|dumb|moron|moronic)
(?:\s+bot)?
| i \s+ hate \s+ (?:you|u)
| bi+tch)
[?!1.\s]*$/osix) and
($self->canAssumeThanks($event))) {
$self->Perform($event, 'yousuck');
} elsif ($message =~ /^\s*(?:good(?:\s$me)?|yay[\s!1.]*|i\s+love\s+(?:you|u))\s+$me[\s!1.]*(?:[;:8][-o]?[]()\|O0<>[]\s*)?$/si) {
$self->Perform($event, 'happy');
} elsif ($message =~ /^\s*(?:$me\s*[.?\/]+)\s*$/si) {
$self->Perform($event, 'listen');
} elsif ($message =~ /^\s*r+h(e+)t+[!1.\s]*$/osi) {
if (($event->{'time'}-$self->{'lastrheet'}) > $self->{'rheetbuffer'}) {
if (length($1) < $self->{'rheetMaxEs'}) {
$self->say($event, "rhe$1$1t!");
}
$self->{'lastrheet'} = $event->{'time'};
}
} elsif ($message =~ /^.+\s+c\+\+\s+.+$/osi) {
if (!(grep {$_ eq '*' or lc($_) eq $event->{'channel'}} @{$self->{'evilMute'}}) &&
($event->{'time'} - $self->{'lastEvil'}) > $self->{'evilBackoffTime'}) {
$self->{'lastEvil'} = $event->{'time'};
$self->Perform($event, 'evil'); # calls GetNext which calls saveConfig
}
} else {
return $self->SUPER::Heard(@_);
}
return 0; # we've dealt with it, no need to do anything else.
}
sub Felt {
my $self = shift;
my ($event, $message) = @_;
my $me = quotemeta($event->{'bot'}->nick);
if ($message =~ /^\s*(?:greets\s+$me|shakes\s+$me'?s\s+hand)[\s!1.]*$/si) {
$self->Perform($event, 'greetings');
} elsif ($message =~ /^\s*(?:pokes|prods)\s+$me(?:[,\s]+too|\s+as\s+well)?[\s!1.]*$/si) {
$self->Perform($event, 'ow');
} elsif ($message =~ /^\s*(?:stabs|slaps|kicks|kills|hits|punches)\s+$me[\s!1.]*$/si) {
$self->Perform($event, 'veryow');
} elsif ($message =~ /^\s*lights\s+$me\s+on\s+fire[!1.\s]*$/si) {
$self->Perform($event, 'veryow');
} elsif ($message =~ /^\s*(?:pats|strokes|pets)\s+$me(:?\s+affectionately|\s+lovingly)?[!1.\s]*$/si) {
$self->Perform($event, 'happy');
} elsif ($message =~ /^\s*slaps\s+$me\s+(?:around\s+)?(?:a\s+(?:bit|lot|little|while)\s+)?with\s+a\s+(?:(?:big|fat|large|wet|and)[\s,]+)*trout[\s!1.]*$/si) {
$self->Perform($event, 'ow');
} elsif ($message =~ /^\s*(?:hits|kicks|slaps|smacks)\s+$me[\s!1.]*$/si) {
$self->Perform($event, 'yousuck');
} elsif ($message =~ /^\s*(?:glares|stares)\s+at\s+$me[\s!1.]*$/si) {
$self->Perform($event, 'yousuck');
} elsif ($message =~ /^\s*(?:hugs|cuddles|snuggles(?:\s+up\s*to|\s+with)?|kisses|loves)\s+$me[\s!1.]*$/si) {
$self->Perform($event, 'vhappy');
} elsif ($message =~ /^\s*(?:bites|spanks)\s+$me[\s.]*$/si) {
$self->Perform($event, 'kinky');
} elsif ($message =~ /^\s*(?:tickles)\s+$me[\s.]*$/si) {
$self->Perform($event, 'tickle');
} elsif ($message =~ /^\s*(?:gives|hands|passes|offers)\s+$me\s+(?:a\s+(?:bot\s*)?(?:snack|cookie)|a\s+present|cash|congratulations|applause|praise)[\s!1.]*$/si) {
$self->Perform($event, 'happy');
} elsif ($message =~ /^\s*(?:gives|hands|passes|offers)\s+$me\s+(?:a\s+hot\s+date)[\s!1.]*$/si) {
$self->Perform($event, 'vhappy');
} else {
return $self->SUPER::Felt(@_);
}
return 0; # we've dealt with it, no need to do anything else.
}
sub Saw {
my $self = shift;
my ($event, $message) = @_;
if ($message =~ /^\s*r+h+e(e+)t+s?[!1.\s]*$/osi) {
if (($event->{'time'}-$self->{'lastrheet'}) > $self->{'rheetbuffer'}) {
$self->say($event, "rhe$1$1t!");
$self->{'lastrheet'} = $event->{'time'};
}
} elsif (($message =~ /^\s*(?:smiles)\s*[!1.\s]*$/si) and ($self->canAssumeThanks($event))) {
$self->Perform($event, 'happy');
} else {
return $self->SUPER::Felt(@_);
}
return 0; # we've dealt with it, no need to do anything else.
}
# SpottedJoin - Called when someone joins a channel
sub SpottedJoin {
my $self = shift;
my ($event, $channel, $who) = @_;
return if grep lc($_) eq $channel, @{$self->{'autoGreetMute'}};
my $user = $event->{'user'};
if ($self->canGreet($event) and $self->{'autoGreetings'}->{$who}) {
$self->sayOrEmote($event, $self->Expand($event, $self->{'autoGreetings'}->{$who}));
$self->{'autoGreeted'}->{$user} = $event->{'time'};
}
return 1; # don't block other modules...
}
sub CTCPPing {
my $self = shift;
my ($event, $who, $what) = @_;
$self->ctcpReply($event, 'PING', $what);
}
sub CTCPSource {
my $self = shift;
my ($event, $who, $what) = @_;
$self->ctcpReply($event, 'SOURCE', $self->{'source'});
}
sub GetNext {
my $self = shift;
my ($list) = @_;
$self->{"${list}Index"} = 0 if $self->{"${list}Index"} > $#{$self->{$list}};
my $reply = $self->{$list}->[$self->{"${list}Index"}++];
$self->saveConfig();
return $reply;
}
sub canGreet {
my $self = shift;
my ($event) = @_;
my $user = $event->{'user'};
my $reply = 1;
if (defined($self->{'autoGreeted'}->{$user})) {
$reply = (($event->{'time'} - $self->{'autoGreeted'}->{$user}) > $self->{'autoGreetedBackoffTime'});
delete($self->{'autoGreeted'}->{$user});
}
return $reply;
}
sub canAssumeThanks {
my $self = shift;
my ($event) = @_;
my $who = $event->{'user'};
return ((defined($self->{'_lastSpoken'}->{$who})) and (($event->{'time'} - $self->{'_lastSpoken'}->{$who}) <= $self->{'assumeThanksTime'}));
}
sub Perform {
my $self = shift;
my ($event, $list) = @_;
$self->sayOrEmote($event, $self->Expand($event, $self->GetNext($list)));
}
# replaces '%' with the target nick (XXX cannot escape a "%"!!!)
sub Expand {
my $self = shift;
my ($event, $data) = @_;
$data =~ s/%/$event->{'from'}/gos;
return $data;
}
sub PerformOnOther {
my $self = shift;
my ($event, $list, $other) = @_;
my $data;
my $me = quotemeta($event->{'nick'});
if ($other =~ m/^$me$/si and
defined $self->{"${list}Protected"}->{''}) {
$data = $self->{"${list}Protected"}->{''};
} elsif (defined $self->{"${list}Protected"}->{lc $other}) {
$data = $self->{"${list}Protected"}->{lc $other};
} else {
$data = $self->GetNext($list);
}
if ($other eq 'me') {
$other = $event->{'from'};
}
$data =~ s/%source/$event->{'from'}/gos;
$data =~ s/%target/$other/gos;
$self->sayOrEmote($event, $data);
}

View File

@@ -1,29 +0,0 @@
################################
# Hello World Module #
################################
package BotModules::HelloWorld;
use vars qw(@ISA);
@ISA = qw(BotModules);
1;
sub Help {
my $self = shift;
my ($event) = @_;
return {
'' => 'This is the demo module that says Hello World.',
'hi' => 'Requests that the bot emit a hello world string.',
};
}
sub Told {
my $self = shift;
my ($event, $message) = @_;
if ($message =~ /^\s*hi\s*$/osi) {
$self->say($event, 'Hello World!');
} else {
return $self->SUPER::Told(@_);
}
return 0; # we've dealt with it, no need to do anything else.
}

View File

@@ -1,790 +0,0 @@
# -*- Mode: perl; tab-width: 4; indent-tabs-mode: nil; -*-
################################
# Infobot Module #
################################
# some of these ideas are stolen from infobot, of course.
# see www.infobot.org
package BotModules::Infobot;
use vars qw(@ISA);
@ISA = qw(BotModules);
use AnyDBM_File;
use Fcntl;
1;
# XXX "mozbot is a bot" fails (gets handled as a Tell of "is a bot" :-/)
# XXX "who is foo" responds "I don't know what is foo" (should respond "I don't know _who_ is foo")
# it seems tie() works on scope and not on reference counting, so as
# soon as the thing it is tying goes out of scope (even if the variable
# in question still has active references) it loses its magic.
our $factoids = {'is' => {}, 'are' => {}};
tie(%{$factoids->{'is'}}, 'AnyDBM_File', 'factoids-is', O_RDWR|O_CREAT, 0666);
tie(%{$factoids->{'are'}}, 'AnyDBM_File', 'factoids-are', O_RDWR|O_CREAT, 0666);
sub Help {
my $self = shift;
my ($event) = @_;
return {
'' => 'Keeps track of factoids and returns them on request. '.
'To set factoids, just tell me something in the form \'apple is a company\' or \'apples are fruit\'. '.
'To find out about something, say \'apple?\' or \'what are apples\'. '.
'To correct me, you can use any of: \'no, apple is a fruit\', \'apple =~ s/company/fruit/\', or \'apple is also a fruit\'. '.
'To make me forget a factoid, \'forget apple\'. '.
'You can use \'|\' to separate several alternative answers.',
'who' => 'If a definition contains $who, then it will be replaced by the name of the person who asked the question.',
'reply' => 'If a definition starts with <reply> then when responding the initial prefix will be skipped. '.
'e.g., \'apples are <reply>mm, apples\' will mean that \'what are apples\' will get the response \'mm, apples\'.',
'action' => 'If a definition starts with <action> then when responding the definition will be used as an action. '.
'e.g., \'apples are <action>eats one\' will mean that \'what are apples\' will get the response \'* bot eats one\'.',
'alias' => 'If a definition starts with <alias> then it will be treated as a symlink to whatever follows. '.
'e.g., \'crab apples are <alias>apples\' and \'apples are fruit\' will mean that \'what are crab apples\' will get the response \'apples are fruit\'.',
'status' => 'Reports on how many factoids are in the database.',
'tell' => 'Make me tell someone something. e.g., \'tell pikachu what apples are\' or \'tell fred about me\'.',
'literal' => 'To find out exactly what is stored for an entry apples, you would say to me: literal apples',
'remember' => 'If you are having trouble making me remember something (for example \'well, foo is bar\' '.
'getting treated as \'foo\' is \'bar\'), then you can prefix your statement with \'remember:\' '.
'(following the \'no,\' if you are changing an entry). For example, \'remember: well, foo is bar\'. '.
'Note that \'well, foo?\' is treated as \'what is foo\' not is \'what is well, foo\', so this is not always useful.',
'no' => 'To correct an entry, prefix your statement with \'no,\'. '.
'For example, \'no, I am good\' to correct your entry from \'is bad\' to \'is good\'. :-)',
};
}
# RegisterConfig - Called when initialised, should call registerVariables
sub RegisterConfig {
my $self = shift;
$self->SUPER::RegisterConfig(@_);
$self->registerVariables(
# [ name, save?, settable? ]
['autoLearn', 1, 1, ['*']], # in the auto* variables, '*' means 'all channels'
['autoHelp', 1, 1, []],
['autoEdit', 1, 1, []],
['neverLearn', 1, 1, []], # the never* variables override the auto* variables
['neverHelp', 1, 1, []],
['neverEdit', 1, 1, []],
['eagerToHelp', 1, 1, 1], # whether to even need the "?" on questions
['autoIgnore', 1, 1, []], # list of nicks for which to always turn off auto*
['teachers', 1, 1, []], # list of users who may teach, leave blank to allow anyone to teach
['factoidPositions', 0, 0, {'is' => {}, 'are' => {}}],
['friendBots', 1, 1, []],
['prefixes', 1, 1, ['', 'I have heard that ', '', 'Maybe ', 'I seem to recall that ', '', 'iirc, ', '',
'Was it not... er, someone, who said: ', '', 'Well, ', 'um... ', 'Oh, I know this one! ',
'', 'everyone knows that! ', '', 'hmm... I think ', 'well, duh. ']],
['researchNotes', 0, 0, {}],
['pruneDelay', 1, 1, 120], # how frequently to look through the research notes and remove expired items
['queryTimeToLive', 1, 1, 600], # queries can be remembered up to ten minutes by default
['dunnoTimeToLive', 1, 1, 604800], # DUNNO queries can be remembered up to a week by default
['noIdeaDelay', 1, 1, 2], # how long to wait before admitting lack of knowledge
['questions', 0, 0, 0], # how many questions there have been since the last load
['edits', 0, 0, 0], # how many edits (learning, editing, forgetting) there have been since the last load
['interbots', 0, 0, 0], # how many times we have spoken with other bots
['maxInChannel', 1, 1, 200], # beyond this answers are /msged
);
}
# Schedule - called when bot connects to a server, to install any schedulers
# use $self->schedule($event, $delay, $times, $data)
# where $times is 1 for a single event, -1 for recurring events,
# and a positive number for an event that occurs that many times.
sub Schedule {
my $self = shift;
my ($event) = @_;
$self->schedule($event, \$self->{'pruneDelay'}, -1, 'pruneInfobot');
$self->SUPER::Schedule($event);
}
sub Unload {
# just to make sure...
untie(%{$factoids->{'is'}});
untie(%{$factoids->{'are'}});
}
sub Told {
my $self = shift;
my ($event, $message) = @_;
if ($message =~ /^\s*status[?\s]*$/osi) {
my $sum = $self->countFactoids();
my $questions = $self->{'questions'} == 1 ? "$self->{'questions'} question" : "$self->{'questions'} questions";
my $edits = $self->{'edits'} == 1 ? "$self->{'edits'} edit" : "$self->{'edits'} edits";
my $interbots = $self->{'interbots'} == 1 ? "$self->{'interbots'} time" : "$self->{'interbots'} times";
my $friends = @{$self->{'friendBots'}} == 1 ? (scalar(@{$self->{'friendBots'}}).' bot friend') : (scalar(@{$self->{'friendBots'}}).' bot friends');
$self->targettedSay($event, "I have $sum factoids in my database and $friends to help me answer questions. ".
"Since the last reload, I've been asked $questions, performed $edits, and spoken with other bots $interbots.", 1);
} elsif ($event->{'channel'} eq '' and $message =~ /^:INFOBOT:DUNNO <(\S+)> (.*)$/) {
$self->ReceivedDunno($event, $1, $2) unless $event->{'from'} eq $event->{'nick'};
} elsif ($event->{'channel'} eq '' and $message =~ /^:INFOBOT:QUERY <(\S+)> (.*)$/) {
$self->ReceivedQuery($event, $2, $1) unless $event->{'from'} eq $event->{'nick'};
} elsif ($event->{'channel'} eq '' and $message =~ /^:INFOBOT:REPLY <(\S+)> (.+?) =(is|are)?=> (.*)$/) {
$self->ReceivedReply($event, $3, $2, $1, $4) unless $event->{'from'} eq $event->{'nick'};
} elsif ($message =~ /^\s*literal\s+(.+?)\s*$/) {
$self->Literal($event, $1);
} elsif ($event->{level} < 10) {
# make this module a very low priority
return 10;
} elsif (not $self->DoFactoidCheck($event, $message, 1)) {
return $self->SUPER::Told(@_);
}
return 0; # we've dealt with it, no need to do anything else.
}
sub Baffled {
my $self = shift;
my ($event, $message) = @_;
return 10 unless $event->{level} >= 10; # make this module a very low priority
if (not $self->DoFactoidCheck($event, $message, 2)) {
return $self->SUPER::Heard(@_);
}
return 0; # we've dealt with it, no need to do anything else.
}
sub Heard {
my $self = shift;
my ($event, $message) = @_;
return 10 unless $event->{level} >= 10; # make this module a very low priority
if (not $self->DoFactoidCheck($event, $message, 0)) {
return $self->SUPER::Heard(@_);
}
return 0; # we've dealt with it, no need to do anything else.
}
sub DoFactoidCheck {
my $self = shift;
my ($event, $message, $direct) = @_;
# $direct is one of: 0 = heard, 1 = told, 2 = baffled
my $shortMessage;
if ($message =~ /^\s* (?:\w+[:.!\s]+\s+)?
(?:(?:well|and|or|yes|[uh]+m*|o+[oh]*[k]+(?:a+y+)?|still|well|so|a+h+|o+h+)[:,.!?\s]+|)*
(?:(?:geez?|boy|du+des?|golly|gosh|wow|whee|wo+ho+)[:,.!\s]+|)*
(?:(?:heya?|hello|hi)(?:\s+there)?(?:\s+peoples?|\s+kids?|\s+folks?)[:,!.?\s]+)*
(?:(?:geez?|boy|du+des?|golly|gosh|wow|whee|wo+ho+)[:,.!\s]+|)*
(?:tell\s+me[,\s]+)?
(?:(?:(?:stupid\s+)?q(?:uestion)?|basically)[:,.!\s]+)*
(?:tell\s+me[,\s]+)?
(?:(?:does\s+)?(?:any|ne)\s*(?:1|one|body)\s+know[,\s]+|)?
(.*)
\s*$/osix) {
$shortMessage = $1;
}
$self->debug("message: '$message'");
$self->debug("shortMessage: '$shortMessage'");
if ($message =~ /^\s*tell\s+(\S+)\s+about\s+me(?:[,\s]+please)?[\s!?.]*$/osi) {
$self->GiveFactoid($event,
undef, # database
$event->{'from'}, # what
$direct,
$1); # who
} elsif ($message =~ /^\s*tell\s+(\S+)\s+about\s+(.+?)(?:[,\s]+please)?[\s!?.]*$/osi) {
$self->GiveFactoid($event,
undef, # database
$2, # what
$direct,
$1); # who
} elsif ($message =~ /^\s*tell\s+(\S+)\s+(?:what|who|where)\s+(?:am\s+I|I\s+am)(?:[,\s]+please)?[\s!?.]*$/osi) {
$self->GiveFactoid($event,
'is', # database
$event->{'from'}, # what
$direct,
$1); # who
} elsif ($message =~ /^\s*tell\s+(\S+)\s+(?:what|who|where)\s+(is|are)\s+(.+?)(?:[,\s]+please)?[\s!?.]*$/osi) {
$self->GiveFactoid($event,
lc($2), # database
$3, # what
$direct,
$1); # who
} elsif ($message =~ /^\s*tell\s+(\S+)\s+(?:what|who|where)\s+(.+?)\s+(is|are)(?:[,\s]+please)?[\s!?.]*$/osi) {
$self->GiveFactoid($event,
lc($3), # database
$2, # what
$direct,
$1); # who
} elsif ($message =~ /^\s*(.+?)\s*=~\s*s?\/(.+?)\/(.*?)\/(i)?(g)?(i)?\s*$/osi) {
$self->EditFactoid($event,
$1, # subject
$2, # first part to remove
$3, # second part to remove
defined($5), # global?
defined($4) || defined($6), # case insensitive?
$direct);
} elsif ($message =~ /^\s*forget\s+(?:about\s+)?me\s*$/osi) {
$self->ForgetFactoid($event, $event->{'from'}, $direct);
} elsif ($message =~ /^\s*forget\s+(?:about\s+)?(.+?)\s*$/osi) {
$self->ForgetFactoid($event, $1, $direct);
} elsif ($shortMessage =~ /^(?:what|where|who)
(?:\s+the\s+hell|\s+on\s+earth|\s+the\s+fuck)?
\s+ (is|are) \s+ (.+?) [?!\s]* $/osix) {
$self->GiveFactoid($event,
lc($1), # is/are (optional)
$2, # subject
$direct);
} elsif ($shortMessage =~ /^(?:(?:where|how)
(?:\s+the\s+hell|\s+on\s+earth|\s+the\s+fuck)?
\s+ can \s+ (?:i|one|s?he|we) \s+ (?:find|learn|read)
(?:\s+about)?
| how\s+about
| what\'?s)
\s+ (.+?) [?!\s]* $/osix) {
$self->GiveFactoid($event,
undef, # is/are (optional)
$1, # subject
$direct);
} elsif ($shortMessage =~ /^(.+?) \s+ (is|are) \s+ (?:what|where|who) [?!\s]* $/osix) {
$self->GiveFactoid($event,
lc($2), # is/are (optional)
$1, # subject
$direct);
} elsif ($shortMessage =~ /^(?:what|where|who)
(?:\s+the\s+hell|\s+on\s+earth|\s+the\s+fuck)? \s+
(?:am\s+I|I\s+am) [?\s]* $/osix) {
$self->GiveFactoid($event,
'is', # am => is
$event->{'from'}, # subject
$direct);
} elsif ($shortMessage =~ /^(no\s*, (\s*\Q$event->{'nick'}\E\s*,)? \s+)? (?:remember\s*:\s+)? (.+?) \s+ (is|are) \s+ (also\s+)? (.*?[^?\s]) \s* $/six) {
# the "remember:" prefix can be used to delimit the start of the actual content, if necessary.
$self->SetFactoid($event,
defined($1) &&
($direct || defined($2)),
# replace existing answer?
$3, # subject
lc($4), # is/are
defined($5), # add to existing answer?
$6, # object
$direct || defined($2));
} elsif ($shortMessage =~ /^(no\s*, (?:\s*\Q$event->{'nick'}\E\s*,)? \s+)? (?:remember\s*:\s+)? I \s+ am \s+ (also\s+)? (.+?) $/osix) {
# the "remember:" prefix can be used to delimit the start of the actual content, if necessary.
$self->SetFactoid($event,
defined($1), # replace existing answer?
$event->{'from'}, # subject
'is', # I am = Foo is
defined($2), # add to existing answer?
$3, # object
$direct);
} elsif ((not $direct or $direct == 2) and $shortMessage =~ /^(.+?)\s+(is|are)[?\s]*(\?)?[?\s]*$/osi) {
$self->GiveFactoid($event,
lc($2), # is/are (optional)
$1, # subject
$direct)
if ($3 or ($direct == 2 and $self->{'eagerToHelp'}));
} elsif ((not $direct or $direct == 2) and $shortMessage =~ /^(.+?)[?!.\s]*(\?)?[?!.\s]*$/osi) {
$self->GiveFactoid($event,
undef, # is/are (optional)
$1, # subject
$direct)
if ($2 or ($direct == 2 and $self->{'eagerToHelp'}));
} else {
return 0;
}
return 1;
}
sub SetFactoid {
my $self = shift;
my($event, $replace, $subject, $database, $add, $object, $direct, $fromBot) = @_;
if ($direct or $self->allowed($event, 'Learn')) {
teacher: {
if (@{$self->{'teachers'}}) {
foreach my $user (@{$self->{'teachers'}}) {
if ($user eq $event->{'userName'}) {
last teacher;
}
}
return 0;
}
}
# update the database
if (not $replace) {
$subject = $self->CanonicalizeFactoid($database, $subject);
} else {
my $oldSubject = $self->CanonicalizeFactoid($database, $subject);
if (defined($factoids->{$database}->{$oldSubject})) {
delete($factoids->{$database}->{$oldSubject});
}
}
if ($replace or not defined($factoids->{$database}->{$subject})) {
$self->debug("Learning that $subject $database '$object'.");
$factoids->{$database}->{$subject} = $object;
} elsif (not $add) {
my @what = split(/\|/o, $factoids->{$database}->{$subject});
local $" = '\' or \'';
if (not defined($fromBot)) {
if (@what == 1 and $what[0] eq $object) {
$self->targettedSay($event, 'Yep, that\'s what I thought. Thanks for confirming it.', $direct);
} else {
# XXX "that's one of the alternatives, sure..."
$self->targettedSay($event, "But $subject $database '@what'...", $direct);
}
}
return 0; # failed to update database
} else {
$self->debug("Learning that $subject $database also '$object'.");
$factoids->{$database}->{$subject} .= "|$object";
}
if (not defined($fromBot)) {
$self->targettedSay($event, 'ok', $direct);
}
if (defined($self->{'researchNotes'}->{lc($subject)})) {
my @queue = @{$self->{'researchNotes'}->{lc($subject)}};
foreach my $entry (@queue) {
my($eventE, $typeE, $databaseE, $subjectE, $targetE, $directE, $visitedAliasesE, $timeE) = @$entry;
if ($typeE eq 'QUERY') {
if ((defined($targetE) and $event->{'from'} ne $targetE) or
($event->{'from'} ne $eventE->{'from'} and
($event->{'channel'} eq '' or $event->{'channel'} ne $eventE->{'channel'}))) {
my($how, $what, $propagated) = $self->GetFactoid($eventE, $databaseE, $subjectE,
$targetE, $directE, $visitedAliasesE, $event->{'from'});
if (defined($how)) {
if (defined($targetE)) {
$self->debug("I now know what '$subject' $database, so telling $targetE, since $eventE->{'from'} told me to.");
} else {
$self->debug("I now know what '$subject' $database, so telling $eventE->{'from'} who wanted to know.");
}
$self->factoidSay($eventE, $how, $what, $directE, $targetE);
$entry->[1] = 'OLD';
} else {
# either $propagated, or database doesn't match requested database, or internal error
$self->debug("I now know what '$subject' $database, but for some reason that ".
"didn't help me help $eventE->{'from'} who needed to know what '$subjectE' $databaseE.");
}
}
} elsif ($typeE eq 'DUNNO') {
my $who = defined($targetE) ? $targetE : $eventE->{'from'};
$self->directSay($eventE, ":INFOBOT:REPLY <$who> $subject =$database=> $factoids->{$database}->{$subject}");
$entry->[1] = 'OLD';
}
}
}
$self->{'edits'}++;
return 1;
} else {
return 0;
}
}
sub GiveFactoid {
my $self = shift;
my($event, $database, $subject, $direct, $target) = @_;
if ($direct or $self->allowed($event, 'Help')) {
if ($target =~ m/^$event->{'nick'}$/i) {
$self->targettedSay($event, 'Oh, yeah, great idea, get me to talk to myself.', $direct);
} else {
if (lc($subject) eq 'you') {
# first, skip some words that are handled by other commonly-used modules
# in particular, 'who are you' is handled by Greeting.bm
return;
}
$self->{'questions'}++;
my($how, $what, $propagated) = $self->GetFactoid($event, $database, $subject, $target, $direct);
if (not defined($how)) {
$self->scheduleNoIdea($event, $database, $subject, $direct, $propagated);
} else {
$self->debug("Telling $event->{'from'} about $subject.");
$self->factoidSay($event, $how, $what, $direct, $target);
}
}
}
}
sub Literal {
my $self = shift;
my($event, $subject) = @_;
my $is = $self->CanonicalizeFactoid('is', $subject);
my $are = $self->CanonicalizeFactoid('are', $subject);
if (defined($is) or defined($are)) {
local $" = '\' or \'';
if (defined($factoids->{'is'}->{$is})) {
my @what = split(/\|/o, $factoids->{'is'}->{$is});
$self->targettedSay($event, "$is is '@what'.", 1);
}
if (defined($factoids->{'are'}->{$are})) {
my @what = split(/\|/o, $factoids->{'are'}->{$is});
$self->targettedSay($event, "$are are '@what'.", 1);
}
} else {
$self->targettedSay($event, "I have no record of anything called '$subject'.", 1);
}
}
sub scheduleNoIdea {
my $self = shift;
my($event, $database, $subject, $direct, $propagated) = @_;
if (ref($propagated)) {
$self->schedule($event, \$self->{'noIdeaDelay'}, 1, 'noIdea', $database, $subject, $direct, $propagated);
} else {
$self->noIdea($event, $database, $subject, $direct);
}
}
sub GetFactoid {
my $self = shift;
my($event, $originalDatabase, $subject, $target, $direct, $visitedAliases, $friend) = @_;
if (not defined($visitedAliases)) {
$visitedAliases = {};
}
my $database;
($database, $subject) = $self->FindFactoid($originalDatabase, $subject);
if (defined($factoids->{$database}->{$subject})) {
my @alternatives = split(/\|/o, $factoids->{$database}->{$subject});
my $answer;
if (@alternatives) {
if (not defined($self->{'factoidPositions'}->{$database}->{$subject})
or $self->{'factoidPositions'}->{$database}->{$subject} >= scalar(@alternatives)) {
$self->{'factoidPositions'}->{$database}->{$subject} = 0;
}
$answer = @alternatives[$self->{'factoidPositions'}->{$database}->{$subject}];
$self->{'factoidPositions'}->{$database}->{$subject}++;
} else {
$answer = @alternatives[0];
}
my $who = defined($target) ? $target : $event->{'from'};
$answer =~ s/\$who/$who/go;
if ($answer =~ /^<alias>(.*)$/o) {
if ($visitedAliases->{$1}) {
return ('msg', "see $subject", 0);
} else {
$visitedAliases->{$subject}++;
my($how, $what, $propagated) = $self->GetFactoid($event, undef, $1, $target, $direct, $visitedAliases);
if (not defined($how)) {
return ('msg', "see $1", $propagated);
} else {
return ($how, $what, $propagated);
}
}
} elsif ($answer =~ /^<action>/o) {
$answer =~ s/^<action>\s*//o;
return ('me', $answer, 0);
} else {
if ($answer =~ /^<reply>/o) {
$answer =~ s/^<reply>\s*//o;
} else {
# pick a 'random' prefix
my $prefix = $self->{'prefixes'}->[$event->{'time'} % @{$self->{'prefixes'}}];
if (lc($who) eq lc($subject)) {
$answer = "${prefix}you are $answer";
} else {
$answer = "$prefix$subject $database $answer";
}
if (defined($friend)) {
$answer = "$friend knew: $answer";
}
}
return ('msg', $answer, 0);
}
} else {
# we have no idea what this is
return (undef, undef, $self->Research($event, $originalDatabase, $subject, $target, $direct, $visitedAliases));
}
}
sub CanonicalizeFactoid {
my $self = shift;
my($database, $subject) = @_;
if (not defined($factoids->{$database}->{$subject})) {
while (my $key = each %{$factoids->{$database}}) {
if (lc($key) eq lc($subject)) {
$subject = $key;
# can't return or 'each' iterator won't be reset XXX
}
}
}
return $subject;
}
sub FindFactoid {
my $self = shift;
my($database, $subject) = @_;
if (not defined($database)) {
$database = 'is';
$subject = $self->CanonicalizeFactoid('is', $subject);
if (not defined($factoids->{'is'}->{$subject})) {
$subject = $self->CanonicalizeFactoid('are', $subject);
if (defined($factoids->{'are'}->{$subject})) {
$database = 'are';
}
}
} else {
$subject = $self->CanonicalizeFactoid($database, $subject);
}
return ($database, $subject);
}
sub EditFactoid {
my $self = shift;
my($event, $subject, $search, $replace, $global, $caseInsensitive, $direct) = @_;
if ($direct or $self->allowed($event, 'Edit')) {
my $database;
($database, $subject) = $self->FindFactoid($database, $subject);
if (not defined($factoids->{$database}->{$subject})) {
$self->targettedSay($event, "Er, I don't know about this $subject thingy...", $direct);
return;
}
$self->debug("Editing the $subject entry.");
my @output;
foreach my $factoid (split(/\|/o, $factoids->{$database}->{$subject})) {
$search = $self->sanitizeRegexp($search);
if ($global and $caseInsensitive) {
$factoid =~ s/$search/$replace/gi;
} elsif ($global) {
$factoid =~ s/$search/$replace/g;
} elsif ($caseInsensitive) {
$factoid =~ s/$search/$replace/i;
} else {
$factoid =~ s/$search/$replace/;
}
push(@output, $factoid);
}
$factoids->{$database}->{$subject} = join('|', @output);
$self->targettedSay($event, 'ok', $direct);
$self->{'edits'}++;
}
}
sub ForgetFactoid {
my $self = shift;
my($event, $subject, $direct) = @_;
if ($direct or $self->allowed($event, 'Edit')) {
my $count = 0;
my $database;
foreach my $db ('is', 'are') {
($database, $subject) = $self->FindFactoid($db, $subject);
if (defined($factoids->{$database}->{$subject})) {
delete($factoids->{$database}->{$subject});
$count++;
}
}
if ($count) {
$self->targettedSay($event, "I've forgotten what I knew about '$subject'.", $direct);
$self->{'edits'}++;
} else {
$self->targettedSay($event, "I never knew anything about '$subject' in the first place!", $direct);
}
}
}
# interbot communications
sub Research {
my $self = shift;
my($event, $database, $subject, $target, $direct, $visitedAliases) = @_;
if (not @{$self->{'friendBots'}}) {
# no bots to ask, bail out
return 0;
}
# now check that we need to ask the bots about it:
my $asked = 0;
if (not defined($self->{'researchNotes'}->{$subject})) {
$self->{'researchNotes'}->{$subject} = [];
} else {
entry: foreach my $entry (@{$self->{'researchNotes'}->{lc($subject)}}) {
my($eventE, $typeE, $databaseE, $subjectE, $targetE, $directE, $visitedAliasesE, $timeE) = @$entry;
if ($typeE eq 'QUERY') {
$asked++; # at least one bot was already asked quite recently
if ((defined($targetE) and lc($targetE) eq lc($targetE)) or
(not defined($targetE) and lc($event->{'from'}) eq lc($eventE->{'from'}))) {
# already queued
return 1;
}
}
}
}
# remember to tell these people about $subject if we ever find out about it:
my $entry = [$event, 'QUERY', $database, $subject, $target, $direct, $visitedAliases, $event->{'time'}];
push(@{$self->{'researchNotes'}->{lc($subject)}}, $entry);
my $who = defined($target) ? $target : $event->{'from'};
if (not $asked) {
# not yet asked, so ask each bot about $subject
foreach my $bot (@{$self->{'friendBots'}}) {
next if $bot eq $event->{'nick'};
local $event->{'from'} = $bot;
$self->directSay($event, ":INFOBOT:QUERY <$who> $subject");
}
$self->{'interbots'}++;
return $entry; # return reference to entry so that we can check if it has been replied or not
} else {
return $asked;
}
}
sub ReceivedReply {
my $self = shift;
my($event, $database, $subject, $target, $object) = @_;
$self->{'interbots'}++;
if (not $self->SetFactoid($event, 0, $subject, $database, 0, $object, 1, 1) and
defined($self->{'researchNotes'}->{lc($subject)})) {
# we didn't believe $event->{'from'}, but we might as well
# tell any users that were wondering.
foreach my $entry (@{$self->{'researchNotes'}->{lc($subject)}}) {
my($eventE, $typeE, $databaseE, $subjectE, $targetE, $directE, $visitedAliasesE, $timeE) = @$entry;
if ($typeE eq 'QUERY') {
$self->factoidSay($eventE, 'msg', "According to $event->{'from'}, $subject $database '$object'.", $directE, $targetE);
} elsif ($typeE eq 'DUNNO') {
my $who = defined($targetE) ? $targetE : $eventE->{'from'};
$self->directSay($eventE, ":INFOBOT:REPLY <$who> $subject =$database=> $object");
}
$entry->[1] = 'OLD';
}
}
}
sub ReceivedQuery {
my $self = shift;
my($event, $subject, $target) = @_;
$self->{'interbots'}++;
if (not $self->tellBot($event, $subject, $target)) {
# in the spirit of embrace-and-extend, we're going to say that
# :INFOBOT:DUNNO means "I don't know, but if you ever find
# out, please tell me".
$self->directSay($event, ":INFOBOT:DUNNO <$event->{'nick'}> $subject");
}
}
sub ReceivedDunno {
my $self = shift;
my($event, $target, $subject) = @_;
$self->{'interbots'}++;
if (not $self->tellBot($event, $subject, $target)) {
# store the request
push(@{$self->{'researchNotes'}->{lc($subject)}}, [$event, 'DUNNO', undef, $1, $target, 0, {}, $event->{'time'}]);
}
}
sub tellBot {
my $self = shift;
my($event, $subject, $target) = @_;
my $count = 0;
my $database;
foreach my $db ('is', 'are') {
($database, $subject) = $self->FindFactoid($db, $subject);
if (defined($factoids->{$database}->{$subject})) {
$self->directSay($event, ":INFOBOT:REPLY <$target> $subject =$database=> $factoids->{$database}->{$subject}");
$count++;
}
}
return $count;
}
sub Scheduled {
my $self = shift;
my ($event, @data) = @_;
if ($data[0] eq 'pruneInfobot') {
my $now = $event->{'time'};
foreach my $key (keys %{$self->{'researchNotes'}}) {
my @new;
foreach my $entry (@{$self->{'researchNotes'}->{$key}}) {
my($eventE, $typeE, $databaseE, $subjectE, $targetE, $directE, $visitedAliasesE, $timeE) = @$entry;
if (($typeE eq 'QUERY' and ($now - $timeE) < $self->{'queryTimeToLive'}) or
($typeE eq 'DUNNO' and ($now - $timeE) < $self->{'dunnoTimeToLive'})) {
push(@new, $entry);
}
}
if (@new) {
$self->{'researchNotes'}->{$key} = \@new;
} else {
delete($self->{'researchNotes'}->{$key});
}
}
} elsif ($data[0] eq 'noIdea') {
my(undef, $database, $subject, $direct, $propagated) = @data;
my($eventE, $typeE, $databaseE, $subjectE, $targetE, $directE, $visitedAliasesE, $timeE) = @$propagated;
# in theory, $eventE = $event, $databaseE = $database,
# $subjectE = $subject, $targetE depends on if this was
# triggered by a tell, $directE = $direct, $visitedAliasesE is
# opaque, and $timeE is opaque.
if ($typeE ne 'OLD') {
$self->noIdea($event, $database, $subject, $direct);
}
} else {
$self->SUPER::Scheduled($event, @data);
}
}
# internal helper routines
sub factoidSay {
my $self = shift;
my($event, $how, $what, $direct, $target) = @_;
if (defined($target)) {
$self->targettedSay($event, "told $target", 1);
my $helper = $event->{'from'};
local $event->{'from'} = $target;
if ($how eq 'me') {
$self->directEmote($event, $what);
} else {
if (length($what)) {
$self->directSay($event, "$helper wanted you to know: $what");
}
}
} elsif ($how eq 'me') {
$self->emote($event, $what);
} else {
if ($event->{'channel'} eq '' or length($what) < $self->{'maxInChannel'}) {
$self->targettedSay($event, $what, 1);
} else {
if ($direct) {
$self->targettedSay($event, substr($what, 0, $self->{'maxInChannel'}) . '... (rest /msged)' , 1);
$self->directSay($event, $what);
} else {
$self->targettedSay($event, substr($what, 0, $self->{'maxInChannel'}) . '... (there is more; ask me in a /msg)' , 1);
}
}
}
}
sub targettedSay {
my $self = shift;
my($event, $message, $direct) = @_;
if ($direct and length($message)) {
$self->say($event, "$event->{from}: $message");
}
}
sub countFactoids {
my $self = shift;
# don't want to use keys() as that would load the whole database index into memory.
my $sum = 0;
while (my $factoid = each %{$factoids->{'is'}}) { $sum++; }
while (my $factoid = each %{$factoids->{'are'}}) { $sum++; }
return $sum;
}
sub allowed {
my $self = shift;
my($event, $type) = @_;
if ($event->{'channel'} ne '') {
foreach my $user (@{$self->{'autoIgnore'}}) {
if ($user eq $event->{'from'}) {
return 0;
}
}
foreach my $channel (@{$self->{"never$type"}}) {
if ($channel eq $event->{'channel'} or
$channel eq '*') {
return 0;
}
}
foreach my $channel (@{$self->{"auto$type"}}) {
if ($channel eq $event->{'channel'} or
$channel eq '*') {
return 1;
}
}
}
return 0;
}
sub noIdea {
my $self = shift;
my($event, $database, $subject, $direct) = @_;
if (lc($subject) eq lc($event->{'from'})) {
$self->targettedSay($event, "Sorry, I've no idea who you are.", $direct);
} else {
if (not defined($database)) {
$database = 'might be';
}
$self->targettedSay($event, "Sorry, I've no idea what '$subject' $database.", $direct);
}
}

View File

@@ -1,69 +0,0 @@
#!/usr/bin/perl -w
######################################
# Infobot Factoid Import/Export Tool #
######################################
use strict;
use AnyDBM_File;
use Fcntl;
if (not @ARGV == 2) {
&use();
} else {
my $command = shift @ARGV;
my $filename = shift @ARGV;
if ($command eq '-d') {
&dump($filename);
} elsif ($command eq '-i') {
&import($filename);
} else {
&use();
}
}
sub use {
print "\n";
print " usage: $0 -d dbname\n";
print " prints out an ascii flat file of the database listed.\n";
print " dbname should be the basename of the db, e.g.\n";
print " $0 -d ../factoids-is > is.fact\n";
print " $0 -d ../factoids-are > are.fact\n";
print "\n";
print " $0 -i dbname\n";
print " imports an ascii flat file into the database listed.\n";
print " dbname should be the basename of the db, e.g.\n";
print " $0 -i ../factoids-is < chemicals.fact\n";
print " $0 -i ../factoids-is < is.fact\n";
print " $0 -i ../factoids-are < are.fact\n";
print "\n";
exit(1);
}
sub dump {
my %db;
tie(%db, 'AnyDBM_File', shift, O_RDONLY, 0666);
while (my ($key, $val) = each %db) {
chomp $val;
print "$key => $val\n";
}
}
sub import {
my %db;
tie(%db, 'AnyDBM_File', shift, O_WRONLY|O_CREAT, 0666);
while (<STDIN>) {
chomp;
unless (m/\s*(.+?)\s+=(?:is=|are=)?>\s+(.+?)\s*$/o) {
m/\s*(.+?)\s+(?:is|are)?\s+(.+?)\s*$/o;
}
if (length($1) and length($2)) {
if (defined($db{$1})) {
if (not $db{$1} =~ m/^(|.*\|)\Q$2\E(|.*\|)$/s) {
$db{$1} .= "|$2";
}
} else {
$db{$1} = $2;
}
}
}
}

View File

@@ -1,195 +0,0 @@
The Infobot Protocol
====================
Reverse engineered from infobot 0.45.3 by Ian Hickson.
QUERY
-----
If a bot is asked something by a user and does not know the answer, it
may send queries to all the bots it knows. Queries must be in private
messages and should have the following form:
:INFOBOT:QUERY <target> subject
...where "target" is the name of the user who sent the query in the
first place, and "subject" is the question that was asked.
In reality, "target" may be any string of non-whitespace character, so
it could be used as an internal ID.
A bot receiving a QUERY message must not try to contact the user given
by "target" (that string should be treated as opaque) and must not
make any assumptions about the "subject" string (it could contain
*anything*, including high bit characters and the works).
It is an error for the "subject" string to contain either "=is=>" or
"=are=>". Receiving bots may ignore this error, however.
Bot authors should carefully consider the potential for cascades
before writing bots that chain QUERY messages. (As in, send out QUERY
messages if they are unable to respond to a QUERY message themselves).
In general, this is not a recommended behaviour.
Bot authors are urged to write protection into their bots to avoid
being affected by poorly written bots that cause cascades.
REPLY
-----
Upon receiving a QUERY message, a bot may, if it has information on
"subject", opt to send a private message back to the originating bot
in the form of a REPLY message. Bots must not send unsolicited REPLY
messages. The form of the REPLY message is:
:INFOBOT:REPLY <target> subject =database=> object
...where "target" is the string of the same name from the original
QUERY message, "subject" is the second string from the original QUERY
message, "database" is one of "is" or "are" depending on the whether
"subject" is determined to be singular or plural respectively, and
"object" is the string that should be assumed to be the answer to
"subject". The string may contain special formatting codes, these are
described below.
Upon receiving a REPLY message, bots should first check that they are
expecting one. If they are, the user identified by the "target" string
should be contacted and given the information represented by the
"object" string. (Remember that the "target" string need not actually
be the nick of the original user; it could be an internal key that
indirectly identifies a user.)
Bots should carefully check the integrity and authenticity of the
"target" string, and must check that "database" is one of "is" or
"are". The "subject" string ends at the first occurance of either
"=is=>" or "=are=>". It is *not* an error for the "object" string to
contain either of those substrings.
Bots may opt to store the information given by a REPLY request so that
future questions may be answered without depending on other bots.
It is suggested that bots credit which bot actually knew the
information when reporting back to the user.
DUNNO
-----
(This is not part of the original infobot protocol. And is, as of
2002-02-05, only supported by the mozbot2 Infobot module.)
Upon receiving a QUERY message, a bot may, if it has no information on
the "subject" in question, reply with a DUNNO message. This message
has basically the same form as the QUERY message:
:INFOBOT:DUNNO <target> subject
The DUNNO message indicates that the bot is not aware of the answer to
the question, but would like to be informed of the answer, should the
first bot ever find out about it. The "target" string should, as with
the QUERY string, be considered opaque.
Upon receiving a DUNNO message, there are several possible responses.
If the bot is aware of the answer to "subject", then it should treat
the DUNNO message as if it was a QUERY message (typically resulting in
a REPLY message). This can occur if, for example, another bot has sent
a REPLY to the original QUERY before this bot has had the chance to
send the DUNNO message.
If the first bot still doesn't know the answer, however, it may store
the DUNNO request internally. If, at a future time, the bot is
informed (either directly by a user or through a REPLY message) about
the answer to "subject", then it may send a REPLY message to the bot
that sent the DUNNO request, informing the bot of the value it learnt.
SPECIAL STRINGS
---------------
The "object" string in the REPLY message may contain several special
flags.
$who
If the string contains the string "$who" then, when the string is
given to the user, it should be replaced by the name of the user.
|
Multiple alternative replies may be encoded in one reply, those
should be separated by a vertical bar.
<reply>
If the string is prefixed by "<reply>" then the string should not
be prefixed by "subject is" or "subject are" as usual.
<action>
The string should be returned via a CTCP ACTION.
<alias>
The string should be taken as the name of another entry to look up.
EXAMPLES
--------
In these examples, A, B and C are bots, and x, y and z are people.
The first example shows a simple case of one bots asking two other
bots for help, one of which gives a reply and the other of which says
it has no idea.
+-------- originator of private message
|
| +--- target of private message
| |
V V
z -> A: what is foo?
A -> z: I have no idea.
A -> B: :INFOBOT:QUERY <z> foo
A -> C: :INFOBOT:QUERY <z> foo
B -> A: :INFOBOT:REPLY <x> foo =is=> bar
C -> A: :INFOBOT:DUNNO <C> foo
A -> x: B knew: foo is bar
A -> C: :INFOBOT:REPLY <C> foo =is=> bar
Note how the DUNNO in this case comes after the REPLY and thus is
immediately answered.
The next example uses <alias>. One bot knows the answer to the
question as an alias to another word, but when the original bot asks
about _that_ word, it is the second bot that can help.
z -> A: what is foo?
A -> z: I have no idea.
A -> B: :INFOBOT:QUERY <z> foo
A -> C: :INFOBOT:QUERY <z> foo
B -> A: :INFOBOT:REPLY <x> foo =is=> <alias>bar
C -> A: :INFOBOT:DUNNO <C> foo
A -> B: :INFOBOT:QUERY <z> bar
A -> C: :INFOBOT:QUERY <z> bar
A -> C: :INFOBOT:REPLY <C> foo =is=> <alias>bar
B -> A: :INFOBOT:DUNNO <B> bar
C -> A: :INFOBOT:REPLY <x> bar =is=> baz
A -> z: C knew: bar is baz
A -> B: :INFOBOT:REPLY <B> bar =is=> baz
Note how the credit actually goes to the second bot. A better bot
might remember all the bots involved and credit all of them. A better
bot might also remember what the original question was and reply "foo
is baz" instead of "bar is baz".
Next we have some examples of special codes. If we have:
foo is bar|<alias>baz|<reply>foo to you too|<action>foos|$who
baz is foo
...then the following are valid responses when asked about foo:
<A> foo is bar
<A> baz is foo
<A> foo to you too
* A foos
<A> foo is z
-- end --

View File

@@ -1,136 +0,0 @@
################################
# Insult Module #
################################
# This is basically a loose port of insultd, a random insult server,
# for self-flagellating maniacs, written on 1991-12-09 by
# garnett@colorado.edu. See http://insulthost.colorado.edu/
package BotModules::Insult;
use vars qw(@ISA);
@ISA = qw(BotModules);
1;
our @adjectives = qw( acidic antique contemptible culturally-unsound
despicable evil fermented festering foul fulminating humid impure
inept inferior industrial left-over low-quality malodorous off-color
penguin-molesting petrified pointy-nosed salty sausage-snorfling
tasteless tempestuous tepid tofu-nibbling unintelligent unoriginal
uninspiring weasel-smelling wretched spam-sucking egg-sucking decayed
halfbaked infected squishy porous pickled coughed-up thick vapid
hacked-up unmuzzled bawdy vain lumpish churlish fobbing rank craven
puking jarring fly-bitten pox-marked fen-sucked spongy droning
gleeking warped currish milk-livered surly mammering ill-borne
beef-witted tickle-brained half-faced headless wayward rump-fed
onion-eyed beslubbering villainous lewd-minded cockered full-gorged
rude-snouted crook-pated pribbling dread-bolted fool-born puny fawning
sheep-biting dankish goatish weather-bitten knotty-pated malt-wormy
saucyspleened motley-mind it-fowling vassal-willed loggerheaded
clapper-clawed frothy ruttish clouted common-kissing pignutted
folly-fallen plume-plucked flap-mouthed swag-bellied dizzy-eyed
gorbellied weedy reeky measled spur-galled mangled impertinent
bootless toad-spotted hasty-witted horn-beat yeasty
imp-bladdereddle-headed boil-brained tottering hedge-born
hugger-muggered elf-skinned Microsoft-loving );
our @amounts = qw( accumulation bucket coagulation enema-bucketful gob
half-mouthful heap mass mound petrification pile puddle stack
thimbleful tongueful ooze quart bag plate ass-full assload );
our @nouns = ('bat toenails', 'bug spit', 'cat hair', 'chicken piss',
'dog vomit', 'dung', 'fat woman\'s stomach-bile', 'fish heads',
'guano', 'gunk', 'pond scum', 'rat retch', 'red dye number-9',
'Sun IPC manuals', 'waffle-house grits', 'yoo-hoo', 'dog balls',
'seagull puke', 'cat bladders', 'pus', 'urine samples', 'squirrel guts',
'snake assholes', 'snake bait', 'buzzard gizzards', 'cat-hair-balls',
'rat-farts', 'pods', 'armadillo snouts', 'entrails', 'snake snot',
'eel ooze', 'slurpee-backwash', 'toxic waste', 'Stimpy-drool',
'poopy', 'poop', 'craptacular carpet droppings', 'jizzum',
'cold sores', 'anal warts', 'IE user');
sub Help {
my $self = shift;
my ($event) = @_;
return {
'' => 'Generate insults on the fly, for when you\'re too lazy to invent some yourself.',
'insult' => 'Insults someone. Syntax: \'insult <who>\'',
};
}
# RegisterConfig - Called when initialised, should call registerVariables
sub RegisterConfig {
my $self = shift;
$self->SUPER::RegisterConfig(@_);
$self->registerVariables(
# [ name, save?, settable? ]
['insultOverrides', 1, 1, { # overrides for the insults (keys must be lowercase)
'' => '%source: exactly how stupid do you think i am?',
'yourself' => '%source: nice try, fool',
'urself' => '%source: at least learn to spell, you moronic noodle',
'mozilla' => '%target: You are nothing but the best browser on the planet.',
'mozilla.org' => '%target: You are nothing but the best caretaker Mozilla ever had.',
'c++' => '%target: you are evil',
}],
);
}
sub Told {
my $self = shift;
my ($event, $message) = @_;
if ($message =~ /^\s*(?:will\s+you\s+)?(?:insult|harass)\s+(\S+?)(?:[\s,.]+please)?[\s.?!]*$/osi) {
my $who = $1;
my $line;
if (lc $who eq 'me') {
$who = $event->{'from'};
}
my $me = quotemeta($event->{'nick'});
if ($who =~ m/^$me$/si and
defined $self->{'insultOverrides'}->{''}) {
$line = $self->{'insultOverrides'}->{''};
} elsif (defined $self->{'insultOverrides'}->{lc $who}) {
$line = $self->{'insultOverrides'}->{lc $who};
} else {
$line = $who . ': ' . $self->generateInsult();
}
$line =~ s/%source/$event->{'from'}/gos;
$line =~ s/%target/$who/gos;
$self->sayOrEmote($event, $line);
} else {
return $self->SUPER::Told(@_);
}
return 0; # we've dealt with it, no need to do anything else.
}
sub generateInsult {
my $self = shift;
#
# Insults are formed by making combinations of:
#
# You are nothing but a(n) {adj} {amt} of {adj} {noun}
#
my $adj1 = $self->rand_idx(\@adjectives);
my $adj2; # musn't be the same as $adj1
my $count = @adjectives;
if ($count > 1) {
my $index = int(rand($count));
if ($adjectives[$index] eq $adj1) {
++$index;
$index = 0 if $index >= $count;
}
$adj2 = $adjectives[$index];
} else {
$adj2 = 'err... of... some';
}
my $amnt = $self->rand_idx(\@amounts);
my $noun = $self->rand_idx(\@nouns);
my $an = $adj1 =~ m/^[aeiou]/ois ? 'an' : 'a';
return "You are nothing but $an $adj1 $amnt of $adj2 $noun.";
}
sub rand_idx {
my $self = shift;
my($array) = @_;
return $array->[int(rand(@$array))];
}

View File

@@ -1,196 +0,0 @@
# -*- Mode: perl; tab-width: 4; indent-tabs-mode: nil; -*-
################################
# Karma Module #
################################
package BotModules::Karma;
use vars qw(@ISA);
@ISA = qw(BotModules);
1;
# RegisterConfig - Called when initialised, should call registerVariables
sub RegisterConfig {
my $self = shift;
$self->SUPER::RegisterConfig(@_);
$self->registerVariables(
# [ name, save?, settable? ]
['scores', 1, 1, {}], # nick => total karma.
['privateScores', 1, 1, {}], # nick => nick karma nick karma...
['secondsDelayRequired', 1, 1, 20],
['_lastspoken', 0, 0, {}], # nick => nick => time
);
}
sub Help {
my $self = shift;
my ($event) = @_;
return {
'' => 'A karma tracker. If you have authenticated (using the \'auth\' command) then it will also keep track of your own setting of people\'s karma, as well as the total of everyone\'s settings. Use the \'rank\' command to find someone\'s karma rank.',
'++' => 'Increase someone\'s karma. Syntax: victim++',
'--' => 'Decrease someone\'s karma. Syntax: victim--',
'rank' => 'Find someone\'s karma level. Omit the victim\'s name to get a complete listing of everyone\'s karma (long). Syntax: \'rank victim\' or just \'rank\'',
};
}
sub Told {
my $self = shift;
my ($event, $message) = @_;
if ($message =~ /^(\S+)\+\+$/os) {
$self->ChangeKarma($event, $1, 1);
} elsif ($message =~ /^(\S+)\-\-$/os) {
$self->ChangeKarma($event, $1, -1);
} elsif ($message =~ /^\s*(?:karma\s+)?ranks?[?\s]*$/os) {
$self->ReportKarmaRanks($event, $1);
} elsif ($message =~ /^\s*karma(?:\s+rank)?\s+(\S+)[?\s]*$/os or
$message =~ /^\s*(?:karma\s+)?rank\s+(\S+)[?\s]*$/os) {
$self->ReportKarma($event, $1);
} else {
return $self->SUPER::Told(@_);
}
return 0; # dealt with it...
}
sub Heard {
my $self = shift;
my ($event, $message) = @_;
if ($message =~ /^(\S*[^-+\s])\+\+$/os) {
$self->ChangeKarma($event, $1, 1);
} elsif ($message =~ /^(\S*[^-+\s])\-\-$/os) {
$self->ChangeKarma($event, $1, -1);
} else {
return $self->SUPER::Told(@_);
}
return 0; # we've dealt with it, no need to do anything else.
}
sub ChangeKarma {
my $self = shift;
my ($event, $who, $delta) = @_;
$self->debug("$who += $delta requested");
if ((defined($self->{'_lastSpoken'}->{$event->{'user'}})) and
(defined($self->{'_lastSpoken'}->{$event->{'user'}}->{lc $who})) and
(($event->{'time'} - $self->{'_lastSpoken'}->{$event->{'user'}}->{lc $who}) <= $self->{'secondsDelayRequired'})) {
$self->{'_lastSpoken'}->{$event->{'user'}}->{lc $who} = $self->{'_lastSpoken'}->{$event->{'user'}}->{lc $who}+5;
my $delay = $self->{'secondsDelayRequired'} - ($event->{'time'} - $self->{'_lastSpoken'}->{$event->{'user'}}->{lc $who});
$self->directSay($event, "You will have to wait another $delay seconds before being able to change ${who}'s karma.");
} else {
if (not defined($self->{'_lastSpoken'}->{$event->{'user'}})) {
$self->{'_lastSpoken'}->{$event->{'user'}} = {};
}
$self->{'_lastSpoken'}->{$event->{'user'}}->{lc $who} = $event->{'time'};
if (lc $event->{'from'} eq lc $who) {
if ($delta > 0) {
$delta = -$delta;
}
}
if ($event->{'channel'} ne '') {
$self->{'scores'}->{lc $who} += $delta;
if ($self->{'scores'}->{lc $who} == 0) {
delete($self->{'scores'}->{lc $who});
}
}
my $nick = lc $event->{'userName'};
if ($nick) {
if (not defined($self->{"privateScores"}->{$nick})) {
$self->{"privateScores"}->{$nick} = (lc($who) . ' ' . $delta);
} else {
my %privateScores = split(' ', $self->{"privateScores"}->{$nick});
$privateScores{lc $who} += $delta;
if ($privateScores{lc $who} == 0) {
delete($privateScores{lc $who});
}
my @privateScores = %privateScores;
local $" = ' ';
$self->{'privateScores'}->{$nick} = "@privateScores";
}
} elsif ($event->{'channel'} eq '') {
$self->say($event, 'For private stats, you need to authenticate. Use the \'newuser\' and \'auth\' commands.');
}
$self->saveConfig();
}
}
sub ReportKarma {
my $self = shift;
my ($event, $who) = @_;
if (not defined($self->{'scores'}->{lc $who})) {
$self->say($event, "$who has no karma.");
} else {
my $karma = $self->{'scores'}->{lc $who};
my @order = sort { $self->{'scores'}->{$b} <=> $self->{'scores'}->{$a} } keys(%{$self->{'scores'}});
my $rank = 0;
if (scalar(@order)) {
user: foreach my $user (@order) {
$rank++;
if (lc $user eq lc $who) {
last user;
}
}
}
$self->say($event, "$who has $karma points of karma (rank $rank).");
}
if ($event->{'channel'} eq '') {
$nick = lc $event->{'userName'};
if ($nick) {
if (not defined($self->{"privateScores"}->{$nick})) {
$self->say($event, "You have not given anyone any karma.");
} else {
my %privateScores = split(' ', $self->{"privateScores"}->{$nick});
my $karma = $privateScores{lc $who};
if (not defined($karma)) {
$self->say($event, "You have not given $who any karma.");
} else {
$self->say($event, "You have given $who $karma points of karma.");
}
}
} else {
$self->say($event, 'For private stats, you need to authenticate. Use the \'newuser\' and \'auth\' commands.');
}
}
}
sub ReportKarmaRanks {
my $self = shift;
my ($event) = @_;
my @order = sort { $self->{'scores'}->{$b} <=> $self->{'scores'}->{$a} } keys(%{$self->{'scores'}});
if (scalar(@order)) {
if ($event->{'channel'} ne '') {
my $top = $order[0];
my $score = $self->{'scores'}->{$top};
$self->say($event, "The person with the most karma is $top with $score points.");
}
$self->directSay($event, "Global rankings:");
$self->ReportKarmaRanksList($event, \@order, $self->{'scores'});
}
if ($event->{'channel'} eq '') {
$nick = lc $event->{'userName'};
if ($nick) {
if (defined($self->{"privateScores"}->{$nick})) {
my %privateScores = split(' ', $self->{"privateScores"}->{$nick});
@order = sort { $privateScores{$b} <=> $privateScores{$a} } keys(%privateScores);
if (scalar(@order)) {
$self->directSay($event, "Personal rankings:");
$self->ReportKarmaRanksList($event, \@order, \%privateScores);
} else {
$self->say($event, "I seem to have lost track of the people to which you gave karma points.");
}
} else {
$self->say($event, "You have not given anyone karma.");
}
} else {
$self->say($event, 'For private stats, you need to authenticate. Use the \'newuser\' and \'auth\' commands.');
}
}
}
sub ReportKarmaRanksList {
my $self = shift;
my($event, $order, $scores) = @_;
my $rank = 1;
foreach my $entry (@$order) {
my $score = $scores->{$entry};
$self->directSay($event, "$rank. $entry ($score)");
$rank++;
}
}

View File

@@ -1,51 +0,0 @@
################################
# KeepAlive Module #
################################
package BotModules::KeepAlive;
use vars qw(@ISA);
@ISA = qw(BotModules);
1;
# RegisterConfig - Called when initialised, should call registerVariables
sub RegisterConfig {
my $self = shift;
$self->SUPER::RegisterConfig(@_);
$self->registerVariables(
# [ name, save?, settable? ]
['delay', 1, 1, 20],
['string', 1, 1, 'ping'],
['target', 1, 1, '#spam'],
);
}
# Schedule - called when bot connects to a server, to install any schedulers
# use $self->schedule($event, $delay, $times, $data)
# where $times is 1 for a single event, -1 for recurring events,
# and a +ve number for an event that occurs that many times.
sub Schedule {
my $self = shift;
my ($event) = @_;
$self->schedule($event, \$self->{'delay'}, -1, 'keepalive');
$self->SUPER::Schedule($event);
}
sub Help {
my $self = shift;
my ($event) = @_;
return {
'' => 'This is a simple keep-alive module, it regularly sends text out. This has been known to help with network lag.',
} if $self->isAdmin($event);
return {};
}
sub Scheduled {
my $self = shift;
my ($event, @data) = @_;
if ($data[0] eq 'keepalive') {
local $event->{'target'} = $self->{'target'};
$self->say($event, $self->{'string'});
} else {
$self->SUPER::Scheduled($event, @data);
}
}

View File

@@ -1,109 +0,0 @@
# -*- Mode: perl; tab-width: 4; indent-tabs-mode: nil; -*-
################################
# KookBot Module #
################################
#
# Based on kookbot.pl by Keunwoo Lee
# http://www.cs.washington.edu/homes/klee/misc/kookbot.html
#
# Whacked by Axel Hecht <axel@pike.org>
package BotModules::KookBot;
use vars qw(@ISA);
@ISA = qw(BotModules);
1;
sub Help {
my $self = shift;
my ($event) = @_;
return {
'' => 'This is the KookBot module. See http://www.cs.washington.edu/homes/klee/misc/kookbot.html for details',
'kook' => 'Requests that the bot kook around.',
};
}
# RegisterConfig - Called when initialised, should call registerVariables
sub RegisterConfig {
my $self = shift;
$self->SUPER::RegisterConfig(@_);
$self->registerVariables(
# [ name, save?, settable? ]
['sentences', 1, 1, 1], # how many sentences to say each time
['good-adjectives', 1, 1, ['intelligent', 'open-minded', 'honest', 'clear', 'practical', 'flexible yet critical', 'harmonious', 'truthful', 'well-constructed', ]],
['good-nouns', 1, 1, ['freedom', 'justice', 'straightforwardness', 'subtlety', 'strength', 'compassion', 'fairness', 'rational approach', 'democracy', 'realism', ]],
['bad-adjectives', 1, 1, ['orthodox', 'malignant', 'malevolent', 'dangerous', 'fascist', 'foolish', 'closed-minded', 'annoying', 'unjust', 'long-winded', 'lacking in support', 'shameful', ]],
['bad-nouns', 1, 1, ['oppression', 'tyranny', 'stupidity', 'ignorance', 'discrimination', 'indifference', 'propaganda', 'prejudice', ]],
['tactics-agree', 1, 1, ['apply principles of', 'embrace', 'think along the same lines as', 'commune with the spirit of', 'would prefer', 'argue strenuously for', 'try to posit', 'show the validity in', ]],
['tactics-object', 1, 1, ['object to', 'reject anything involved with', 'refuse to accept', 'argue strenuously against', 'completely disagree with', 'rebut', 'take issue with']],
['productions', 1, 1, [
# OK, so here's the key:
# \0 = good_adjective
# \1 = good_noun
# \2 = bad_adjective
# \3 = bad_noun
# \4 = tactics_agree
# \5 = tactics_object
'You \4 the \2 \3 to \1.',
'True \0 \1 proceeds from examining \1, not \3.',
'One must consider \1 versus \3.',
'I can only imagine that you \4 \3.',
'You \4 \2 \3. I \5 that.',
'The argument you \4 would result in \3.',
'Think about the \3, \2 and \2, and how it compares with \0 \1.',
'I ask you to be \0, not \2. You \5 any appearance of \1.',
'Is this \0? I think it is obvious that your statement is \2 and \2.',
'But there is a \0 \1, and your argument would \5 it.',
'Can there be any doubt? I \4 \0, \0 \1, and you obviously do not.',
'You \5 the fact that your evidence is shallow, the result of \2 propaganda and \3.',
'Yet your argument tries to \5 everything that is \0.',
'It is only the \0 evidence that you \5, and it is because you \5 \1.',
'I \5 your arguments only. There is no personal attack here.',
]],
);
}
sub Told {
my $self = shift;
my ($event, $message) = @_;
my $dokook = undef;
if ((($event->{'level'} == 1) and ($self->isAdmin($event))) or
(($event->{'level'} == 3) and ($event->{'God_channel_rights'}) and
($event->{'KookBot_channel'} eq $event->{'God_channel'}))) {
if ($message =~ /^\s*kook\s+(\S+)\s*$/osi) {
$dokook = $1;
}
}
if (($message =~ /^\s*kook\s*$/osi) or defined($dokook)) {
my @output;
for (my $i = 0; $i < $self->{'sentences'}; $i++) {
my $line = $self->rand_idx('productions');
$line =~ s/\\0/$self->rand_idx('good-adjectives')/goe;
$line =~ s/\\1/$self->rand_idx('good-nouns')/goe;
$line =~ s/\\2/$self->rand_idx('bad-adjectives')/goe;
$line =~ s/\\3/$self->rand_idx('bad-nouns')/goe;
$line =~ s/\\4/$self->rand_idx('tactics-agree')/goe;
$line =~ s/\\5/$self->rand_idx('tactics-object')/goe;
push(@output, $line);
}
local $event->{'target'} = $event->{'target'};
if (defined($dokook)) {
$event->{'target'} = $dokook;
}
local $" = ' ';
$self->say($event, "@output");
} else {
if (($event->{'level'} == 1) and ($message =~ /^\s*kook\s+(\S+)\s*$/osi)) {
$event->{'God_channel'} = lc($1);
$event->{'KookBot_channel'} = lc($1);
}
my $result = $self->SUPER::Told(@_);
return $result < (3 * defined($event->{'KookBot_channel'})) ? 3 : $result;
}
return 0; # we've dealt with it, no need to do anything else.
}
sub rand_idx {
my $self = shift;
my($array) = @_;
return $self->{$array}->[int(rand(@{$self->{$array}}))];
}

View File

@@ -1,179 +0,0 @@
# -*- Mode: perl; tab-width: 4; indent-tabs-mode: nil; -*-
################################
# List Module #
################################
package BotModules::List;
use vars qw(@ISA);
@ISA = qw(BotModules);
1;
# XXX Wipe entire list command
# RegisterConfig - Called when initialised, should call registerVariables
sub RegisterConfig {
my $self = shift;
$self->SUPER::RegisterConfig(@_);
$self->registerVariables(
# [ name, save?, settable? ]
['lists', 1, 1, {}], # user => 'list name|item 1|item 2||list name|item1|item 2'
['preferredLineLength', 1, 1, 80], # the usual
['maxItemsInChannel', 1, 1, 20], # max number of items to print in the channel (above this and direct messages are used)
);
}
sub Help {
my $self = shift;
my ($event) = @_;
return {
'' => 'A personal list tracker. Store your lists here. You must be authenticated to use this (see \'newuser\'). Use the \'add\' command to add items to a list.',
'add' => 'Add an item to a personal list. List names shouldn\'t contain the word \'to\' otherwise things will be too ambiguous. Syntax: \'add <thing to add> to <list name> list\', e.g. \'add bug 5693 to critical bug list\'.',
'remove' => 'Remove an item from a personal list. Syntax: \'remove <thing to add> from <list name> list\', e.g. \'remove bug 5693 from critical bug list\'.',
'list' => 'List the items in your list. Syntax: \'list items in <name of list> list\', e.g. \'list items in critical bug list\' or just \'critical bug list\'.',
'lists' => 'Tells you what lists you have set up.',
};
}
sub Told {
my $self = shift;
my ($event, $message) = @_;
if ($message =~ /^\s*add\s+(\S(?:.*\S)?)\s+to\s+(?:my\s+)?(\S(?:.*\S)?)\s+list[\s!.]*$/osi and $message !~ /\|/o and $event->{'userName'}) {
$self->AddItem($event, $1, $2);
} elsif ($message =~ /^\s*remove\s+(\S(?:.*\S)?)\s+from\s+(?:my\s+)?(\S(?:.*\S)?)\s+list[\s!.]*$/osi and $message !~ /\|/o and $event->{'userName'}) {
$self->RemoveItem($event, $1, $2);
} elsif ($message =~ /^\s* (?:examine \s+ |
list \s+ items \s+ in \s+ |
what (?:\s+is|'s) \s+ (?:in\s+)? )
(?: my \s+ | the \s+ )?
( \S (?:.*\S)? )
\s+ list [\s!?.]* $/osix
and $message !~ /\|/o and $event->{'userName'}) {
$self->ListItems($event, $1);
} elsif ($message =~ /^\s*lists[?\s.!]*$/osi and $event->{'userName'}) {
$self->ListLists($event, $1);
} else {
return $self->SUPER::Told(@_);
}
return 0; # dealt with it...
}
sub Baffled {
my $self = shift;
my ($event, $message) = @_;
if ($message =~ /^\s*(\S(?:.*\S)?)\s+list[\s!?.]*$/osi and $message !~ /\|/o and $event->{'userName'}) {
$self->ListItems($event, $1);
} else {
return $self->SUPER::Baffled(@_);
}
return 0; # dealt with it...
}
sub Heard {
my $self = shift;
my ($event, $message) = @_;
if ($message =~ /^\s*add\s+(\S(?:.*\S)?)\s+to\s+(?:my\s+)?(\S(?:.*\S)?)\s+list[\s!.]*$/osi and $message !~ /\|/o and $event->{'userName'}) {
$self->AddItem($event, $1, $2);
} elsif ($message =~ /^\s*remove\s+(\S(?:.*\S)?)\s+from\s+(?:my\s+)?(\S(?:.*\S)?)\s+list[\s!.]*$/osi and $message !~ /\|/o and $event->{'userName'}) {
$self->RemoveItem($event, $1, $2);
} else {
return $self->SUPER::Told(@_);
}
return 0; # dealt with it...
}
sub AddItem {
my $self = shift;
my ($event, $what, $list) = @_;
my @lists = split(/\|\|/o, $self->{'lists'}->{$event->{'userName'}});
local $" = '\', \'';
my %lists;
foreach my $sublist (@lists) {
my @items = split(/\|/o, $sublist);
$lists{shift @items} = \@items;
}
push(@{$lists{lc $list}}, $what);
local $" = '|';
my $compoundLists = '';
foreach my $list (keys(%lists)) {
if ($compoundLists ne '') {
$compoundLists .= '||';
}
$compoundLists .= "$list|@{$lists{$list}}";
}
$self->{'lists'}->{$event->{'userName'}} = $compoundLists;
$self->saveConfig();
$self->say($event, "$event->{'from'}: stored '$what' in '$list' list");
}
sub RemoveItem {
my $self = shift;
my ($event, $what, $list) = @_;
my @lists = split(/\|\|/o, $self->{'lists'}->{$event->{'userName'}});
local $" = '\', \'';
my %lists;
my $removed = 0;
foreach my $sublist (@lists) {
my @items = split(/\|/o, $sublist);
if (lc $list eq $items[0]) {
my $listName = shift @items;
foreach my $item (@items) {
if (lc $what ne lc $item) {
push(@{$lists{$listName}}, $item);
} else {
$removed++;
}
}
} else {
$lists{shift @items} = \@items;
}
}
local $" = '|';
my $compoundLists = '';
foreach my $list (keys(%lists)) {
if ($compoundLists ne '') {
$compoundLists .= '||';
}
$compoundLists .= "$list|@{$lists{$list}}";
}
$self->{'lists'}->{$event->{'userName'}} = $compoundLists;
$self->saveConfig();
if ($removed) {
$self->say($event, "$event->{'from'}: removed '$what' from '$list' list");
} else {
$self->say($event, "$event->{'from'}: could not find '$what' in '$list' list");
}
}
sub ListItems {
my $self = shift;
my ($event, $list) = @_;
my @lists = split(/\|\|/o, $self->{'lists'}->{$event->{'userName'}});
my %lists;
foreach my $list (@lists) {
my @items = split(/\|/o, $list);
$lists{lc shift @items} = \@items;
}
if (defined(@{$lists{lc $list}})) {
my $size = scalar(@{$lists{lc $list}});
if ($size > $self->{'maxItemsInChannel'}) {
$self->channelSay($event, "$event->{'from'}: Your $list list contains $size items, which I am /msg'ing you.");
$self->directSay($event, $self->prettyPrint($self->{'preferredLineLength'}, "Your $list list contains: ", '', ', ', @{$lists{lc $list}}));
} else {
$self->say($event, $self->prettyPrint($self->{'preferredLineLength'}, "Your $list list contains: ", $event->{'channel'} eq '' ? '' : "$event->{'from'}: ", ', ', @{$lists{lc $list}}));
}
} else {
$self->say($event, "You don't have a $list list, sorry.");
}
}
sub ListLists {
my $self = shift;
my ($event) = @_;
my @lists = split(/\|\|/o, $self->{'lists'}->{$event->{'userName'}});
my @listNames;
foreach my $list (@lists) {
my @items = split(/\|/o, $list);
push(@listNames, $items[0]);
}
$self->say($event, $self->prettyPrint($self->{'preferredLineLength'}, "Your lists are: ", $event->{'channel'} eq '' ? '' : "$event->{'from'}: ", ', ', @listNames));
}

View File

@@ -1,77 +0,0 @@
# -*- Mode: perl; tab-width: 4; indent-tabs-mode: nil; -*-
################################
# Magic Eight Ball #
################################
package BotModules::MagicEightBall;
use vars qw(@ISA);
@ISA = qw(BotModules);
1;
sub Help {
my $self = shift;
my ($event) = @_;
return {
'' => 'The all knowing magic eight ball, in electronic form. Ask a question and the answer shall be provided.',
$self->{'prefix'}.'ball' => "Ask the Magic Eight Ball a question. Syntax: '$self->{'prefix'}ball: will it happen?'",
};
}
# RegisterConfig - Called when initialised, should call registerVariables
sub RegisterConfig {
my $self = shift;
$self->SUPER::RegisterConfig(@_);
$self->registerVariables(
# [ name, save?, settable? ]
['prefix', 1, 1, '!8'], # the prefix to put before the 'ball' command
['responses-positive', 1, 1, ['It is possible.', 'Yes!', 'Of course.', 'Naturally.', 'Obviously.',
'One would be wise to think so.', 'The outlook is good.', 'It shall be.',
'The answer is certainly yes.', 'It is so.']],
['responses-negative', 1, 1, ['In your dreams.', 'No.', 'No chance.', 'Unlikely.', 'About as likely as pigs flying.',
'You\'re kidding, right?', 'The outlook is poor.', 'I doubt it very much.',
'The answer is a resounding no.', 'NO!', 'NO.']],
['responses-unknown', 1, 1, ['Maybe...', 'The outlook is hazy, please ask again later.', 'No clue.',
'What are you asking me for?', '_I_ don\'t know.', 'Come again?',
'You know the answer better than I.', 'The answer is def-- oooh! shiny thing!']],
);
}
sub Told {
my $self = shift;
return ($self->CheckTheBall(@_) and $self->SUPER::Told(@_));
}
sub Heard {
my $self = shift;
return ($self->CheckTheBall(@_) and $self->SUPER::Told(@_));
}
sub CheckTheBall {
my $self = shift;
my ($event, $message) = @_;
if ($message =~ m/$self->{'prefix'}ball[\s:,]+(\S.+\w.+)$/si) {
# -- #buncs was here --
# <Kam> !8ball: are you a fish?
# <oopsbot> Kam: About as likely as pigs flying.
# <Kam> !8ball: is the world flat?
# <oopsbot> Kam: The answer is a resounding no.
# <Kam> !8ball: is the world round?
# <oopsbot> Kam: _I_ don't know.
# <Kam> !8ball: is the world spherical?
# <oopsbot> Kam: The answer is certainly yes.
# <Kam> how DOES it do that? :)
# <Hixie> it's gooood :-)
# trim the fat from the question
$message =~ s/\W//gos;
# pick a reply category that will always be the same for this exact question
my $response = $self->{['responses-positive', 'responses-negative', 'responses-unknown']->[(length($message) % 3)]};
# pick a specific reply that will be different to recent ones
$response = $response->[$event->{'time'} % @$response];
$self->say($event, "$event->{'from'}: $response");
} else {
return 1;
}
return 0;
}

View File

@@ -1,155 +0,0 @@
################################
# MiniLogger Module #
################################
package BotModules::MiniLogger;
use vars qw(@ISA);
@ISA = qw(BotModules);
1;
sub Help {
my $self = shift;
my ($event) = @_;
my %help = (
'' => 'This module keeps a log of the last few comments that match some patterns. For example, it can be used to remember URIs that have recently been mentioned.',
);
foreach (keys %{$self->{'patterns'}}) {
$help{$_} = 'Returns any recent comment that matched the pattern /'.$self->sanitizeRegexp($self->{'patterns'}->{$_})."/. To narrow the search down even more, you can include a search string after the $_, as in '$_ goats'. To restrict the search to a particular channel, append \'in <channel>\' at the end.";
}
if ($self->isAdmin($event)) {
$help{''} .= ' To add a new pattern, use the following syntax: vars MiniLogger patterns \'+|name|pattern\'';
$help{'flush'} = 'Deletes any logs for patterns or channels that are no longer relevant, makes sure all the logs are no longer than the \'bufferSize\' length. Syntax: \'flush minilogs\'.';
}
return \%help;
}
# RegisterConfig - Called when initialised, should call registerVariables
sub RegisterConfig {
my $self = shift;
$self->SUPER::RegisterConfig(@_);
$self->registerVariables(
# [ name, save?, settable? ]
['log', 0, 0, {}], # log -> channel -> patternName -> [<who> text]
['bufferSize', 1, 1, 20], # number of comments to remember, per channel/pattern combination
['patterns', 1, 1, {'links'=>'<?(:?[Uu][Rr][LlIi]:)?\s*(?:https?|ftp)://[^\s>"]+>?'}], # list of patternNames and patterns (regexp)
['blockedPatterns', 1, 1, []], # list of patterns (regexp) to ignore
);
}
sub Told {
my $self = shift;
my ($event, $message) = @_;
if (($message =~ /^\s*([a-zA-Z0-9]+)(?:\s+(.+?))?(?:\s+in\s+(.+?))?\s*$/osi) and ($self->{'patterns'}->{$1})) {
$self->Report($event, $3, $1, $2); # event, channel, log, pattern
} elsif ($self->isAdmin($event)) {
if ($message =~ /^\s*flush\s+minilogs\s*$/osi) {
$self->FlushMinilogs($event);
} else {
return $self->SUPER::Told(@_);
}
} else {
return $self->SUPER::Told(@_);
}
return 0; # we've dealt with it, no need to do anything else.
}
sub Log {
my $self = shift;
my ($event) = @_;
if (($event->{'firsttype'} eq 'Told') or ($event->{'firsttype'} eq 'Heard')) {
$self->DoLog($event, "<$event->{'from'}> $event->{'data'}");
} elsif (($event->{'firsttype'} eq 'Felt') or ($event->{'firsttype'} eq 'Saw')) {
$self->DoLog($event, "* $event->{'from'} $event->{'data'}");
}
}
sub DoLog {
my $self = shift;
my ($event, $message) = @_;
if ($event->{'channel'} ne '') {
# don't log private messages
foreach my $pattern (keys %{$self->{'patterns'}}) {
my $regexp = $self->sanitizeRegexp($self->{'patterns'}->{$pattern});
if ($message =~ /$regexp/s) {
# wohay, we have a candidate!
# now check for possible blockers...
unless ($self->isBlocked($message)) {
$self->debug("LOGGING: $message");
push(@{$self->{'log'}->{$event->{'channel'}}->{$pattern}}, $message);
if (@{$self->{'log'}->{$event->{'channel'}}->{$pattern}} > $self->{'bufferSize'}) {
shift(@{$self->{'log'}->{$event->{'channel'}}->{$pattern}});
}
}
}
}
}
}
sub isBlocked {
my $self = shift;
my ($message) = @_;
foreach my $blockedPattern (@{$self->{'blockedPatterns'}}) {
my $regexp = $self->sanitizeRegexp($blockedPattern);
if ($message =~ /$regexp/s) {
return 1;
}
}
return 0;
}
sub Report {
my $self = shift;
my ($event, $channel, $log, $pattern) = @_;
my @channels = $channel ? lc($channel) : @{$self->{'channels'}};
my $count;
$pattern = $self->sanitizeRegexp($pattern);
foreach $channel (@channels) {
foreach my $match (@{$self->{'log'}->{$channel}->{$log}}) {
if ((!$pattern) or ($match =~ /$pattern/s)) {
$self->directSay($event, $match);
$count++;
}
}
}
unless ($count) {
$self->directSay($event, 'No matches, sorry.');
}
$self->channelSay($event, "$event->{'from'}: minilog matches /msg'ed");
}
sub FlushMinilogs {
my $self = shift;
my ($event) = @_;
# remove dead channels
my %channels = map { lc($_) => 1 } @{$self->{'channels'}};
foreach my $channel (keys %{$self->{'log'}}) {
if ($channels{$channel}) {
# remove dead logs
foreach my $pattern (keys %{$self->{'log'}->{$channel}}) {
if ($self->{'patterns'}) {
# remove any newly blocked patterns
my @newpatterns;
foreach my $match (@{$self->{'log'}->{$channel}->{$pattern}}) {
unless ($self->isBlocked($match)) {
push (@newpatterns, $match);
}
}
# remove excess logs
if (@newpatterns) {
@{$self->{'log'}->{$channel}->{$pattern}} = (@newpatterns[
@newpatterns - $self->{'bufferSize'} < 0 ? 0 : @newpatterns - $self->{'bufferSize'},
$#newpatterns]
);
} else {
@{$self->{'log'}->{$channel}->{$pattern}} = ();
}
} else {
delete($self->{'log'}->{$channel}->{$pattern});
}
}
} else {
delete($self->{'log'}->{$channel});
}
}
$self->say($event, 'Minilogs flushed.');
}

View File

@@ -1,66 +0,0 @@
################################
# Parrot Module #
################################
package BotModules::Parrot;
use vars qw(@ISA);
@ISA = qw(BotModules);
1;
sub Help {
my $self = shift;
my ($event) = @_;
if ($self->isAdmin($event)) {
return {
'' => 'This module allows you to make the bot do stuff.',
'say' => 'Makes the bot say something. The <target> can be a person or channel. Syntax: say <target> <text>',
'do' => 'Makes the bot do (/me) something. The <target> can be a person or channel. Syntax: do <target> <text>',
'invite' => 'Makes the bot invite (/invite) somebody to a channel. Syntax: invite <who> <channel>',
'announce' => 'Makes the bot announce something to every channel in which this module is enabled. Syntax: announce <text>',
};
} else {
return $self->SUPER::Help($event);
}
}
sub Told {
my $self = shift;
my ($event, $message) = @_;
if ((($event->{'level'} == 1) and ($self->isAdmin($event))) or
(($event->{'level'} == 3) and ($event->{'God_channel_rights'}) and ($event->{'Parrot_channel'} eq $event->{'God_channel'}))) {
if ($message =~ /^\s*say\s+(\S+)\s+(.*)$/osi) {
local $event->{'target'} = $1;
$self->say($event, $2);
} elsif ($message =~ /^\s*do\s+(\S+)\s+(.*)$/osi) {
local $event->{'target'} = $1;
$self->emote($event, $2);
} elsif ($message =~ /^\s*announce\s+(.*)$/osi) {
$self->announce($event, $1);
} elsif ($message =~ /^\s* invite \s+
(\S+) \s+
(?: (?:in|to|into) \s+
(?:channel \s+)? )?
(\S+) \s*$/osix) {
$self->invite($event, $1, $2);
} else {
return $self->SUPER::Told(@_);
}
} else {
if (($event->{'level'} == 1) and (($message =~ /^\s*say\s+(\S+)\s+(.*)$/osi) or ($message =~ /^\s*do\s+(\S+)\s+(.*)$/osi))) {
$event->{'God_channel'} = lc($1);
$event->{'Parrot_channel'} = lc($1);
}
my $result = $self->SUPER::Told(@_);
return $result < (3 * defined($event->{'Parrot_channel'})) ? 3 : $result;
# Note: We go through some contortions here because if the parent
# returns 3 or more, some other module sets God_channel, and
# the command is either not 'say' or 'do' (or the God_channel happens
# to be different to the channel we are looking at) then it is theoretically
# possible that God_channel_rights could be set, but not for the channel
# we care about. Or something..... ;-)
}
return 0; # we've dealt with it, no need to do anything else.
}

View File

@@ -1,571 +0,0 @@
# -*- Mode: perl; tab-width: 4; indent-tabs-mode: nil; -*-
################################
# Quiz Module #
################################
# some of these ideas are stolen from moxquizz (an eggdrop module)
# see http://www.meta-x.de/moxquizz/
package BotModules::Quiz;
use vars qw(@ISA);
@ISA = qw(BotModules);
1;
# XXX high score table
# XXX do something with level
# XXX make bot able to self-abort if no-one is taking part
# XXX implement feature so that users that can be quiz admins in certain channels
# XXX accept user submission
# XXX README for database format (for now see http://www.meta-x.de/moxquizz/README.database)
# XXX pause doesn't stop count of how long answer takes to answer
# XXX different quiz formats, e.g. university challenge, weakest link (maybe implement by inheritance?)
# XXX stats, e.g. number of questions skipped
# XXX category filtering
sub Help {
my $self = shift;
my($event) = @_;
my $help = {
'' => "Runs quizzes. Start a quiz with the $self->{'prefix'}ask command.",
$self->{'prefix'}.'ask' => 'Starts a quiz.',
$self->{'prefix'}.'pause' => "Pauses the current quiz. Resume with $self->{'prefix'}resume.",
$self->{'prefix'}.'resume' => 'Resumes the current quiz.',
$self->{'prefix'}.'repeat' => 'Repeats the current question.',
$self->{'prefix'}.'endquiz' => 'Ends the current quiz.',
$self->{'prefix'}.'next' => 'Jump to the next question (at least half of the active participants have to say this for the question to be skipped).',
$self->{'prefix'}.'score' => 'Show the current scores for the round.',
};
if ($self->isAdmin($event)) {
$help->{'reload'} = 'To just reload the quiz data files instead of the whole module, use: reload Quiz Data';
}
return $help;
}
# RegisterConfig - Called when initialised, should call registerVariables
sub RegisterConfig {
my $self = shift;
$self->SUPER::RegisterConfig(@_);
$self->registerVariables(
# [ name, save?, settable? ]
['questionSets', 1, 1, ['trivia.en']], # the list of files to read (from the Quiz/ directory)
['questions', 0, 0, []], # the list of questions (hashes)
['categories', 0, 0, {}], # hash of arrays whose values are indexes into questions
['questionsPerRound', 1, 1, -1], # how many questions per round (-1 = infinite)
['currentQuestion', 1, 0, {}], # the active question (per-channel hash)
['questionIndex', 1, 0, 0], # where to start when picking the next question
['skipMargin', 1, 1, 10], # maximum number of questions to skip at a time
['remainingQuestions', 1, 0, {}], # how many more questions this round (per-channel hash)
['questionsTime', 1, 0, {}], # when the question was asked
['quizTime', 1, 0, {}], # when the quiz was started
['paused', 1, 0, {}], # if the game is paused
['totalScores', 1, 1, {}], # user => score
['quizScores', 1, 0, {}], # channel => "user score"
['skip', 1, 0, {}], # channel => "user 1"
['players', 1, 0, {}], # channel => "user last time"
['tip', 1, 0, {}], # which tip should next be given on this channel
['tipDelay', 1, 1, 10], # seconds to wait before giving a tip
['timeout', 1, 1, 120], # seconds to wait before giving up
['skipFractionRequired', 1, 1, 0.5], # fraction of players that must say !skip to skip
['askDelay', 1, 1, 2], # how long to wait between answer and question
['prefix', 1, 1, '!'], # the prefix to have at the start of commands
);
}
sub Schedule {
my $self = shift;
my($event) = @_;
$self->reloadData($event);
my $fakeEvent = {%$event};
foreach my $channel (keys %{$self->{'currentQuestion'}}) {
$fakeEvent->{'channel'} = $channel;
$fakeEvent->{'target'} = $channel;
$self->debug("Restarting quiz in $channel... (qid $self->{'questionsTime'}->{$channel})");
$self->schedule($fakeEvent, \$self->{'tipDelay'}, 1, 'tip', $self->{'questionsTime'}->{$channel});
$self->schedule($fakeEvent, \$self->{'timeout'}, 1, 'timeout', $self->{'questionsTime'}->{$channel});
if ($self->{'questionsTime'}->{$event->{'channel'}} == 0) {
$self->schedule($event, \$self->{'askDelay'}, 1, 'ask');
}
}
$self->SUPER::Schedule($event);
}
sub Told {
my $self = shift;
my($event, $message) = @_;
if ($message =~ /^\s*reload\s+quiz\s+data\s*$/osi and $self->isAdmin($event)) {
my $count = $self->reloadData($event);
$self->say($event, "$count questions loaded");
} elsif ($message =~ /^\s*status[?\s]*$/osi) {
my $questions = @{$self->{'questions'}};
my $quizzes = keys %{$self->{'currentQuestion'}};
$self->say($event, "$event->{'from'}: I have $questions questions and am running $quizzes quizzes.", 1); # XXX 1 quizzes
} elsif (not $self->DoQuizCheck($event, $message, 1)) {
return $self->SUPER::Told(@_);
}
return 0; # we've dealt with it, no need to do anything else.
}
sub Baffled {
my $self = shift;
my($event, $message) = @_;
if (not $self->quizAnswer($event, $message)) {
return $self->SUPER::Baffled(@_);
}
return 0; # we've dealt with it, no need to do anything else.
}
sub Heard {
my $self = shift;
my($event, $message) = @_;
if (not $self->DoQuizCheck($event, $message, 0) and
not $self->quizAnswer($event, $message)) {
return $self->SUPER::Heard(@_);
}
return 0; # we've dealt with it, no need to do anything else.
}
sub DoQuizCheck {
my $self = shift;
my($event, $message, $direct) = @_;
if ($message =~ /^\s*\Q$self->{'prefix'}\Eask\s*$/si) {
$self->quizStart($event);
} elsif ($message =~ /^\s*\Q$self->{'prefix'}\Epause\s*$/si) {
$self->quizPause($event);
} elsif ($message =~ /^\s*\Q$self->{'prefix'}\E(?:resume|unpause)\s*$/si) {
$self->quizResume($event);
} elsif ($message =~ /^\s*\Q$self->{'prefix'}\Erepeat\s*$/si) {
$self->quizRepeat($event);
} elsif ($message =~ /^\s*\Q$self->{'prefix'}\E(?:end|stop|strivia|exit)(?:quiz)?\s*$/si) {
$self->quizEnd($event);
} elsif ($message =~ /^\s*\Q$self->{'prefix'}\E(?:dunno|skip|next)\s*$/si) {
$self->quizSkip($event);
} elsif ($message =~ /^\s*\Q$self->{'prefix'}\E(?:scores)\s*$/si) {
$self->quizScores($event);
} else {
return 0;
}
return 1;
}
sub reloadData {
my $self = shift;
my($event) = @_;
$self->{'questions'} = [];
$self->{'categories'} = {};
$self->debug('Loading quiz data...');
foreach my $set (@{$self->{'questionSets'}}) {
if ($set =~ m/^[a-zA-Z0-9-][a-zA-Z0-9.-]*$/os) {
local *FILE;
if (not open(FILE, "<BotModules/Quiz/$set")) { # XXX what if the directory has changed?
$self->debug(" * $set (Not loaded; $!)");
next;
}
$self->debug(" * $set");
my $category;
my $question = {'tip' => []};
while (defined($_ = <FILE>)) {
chomp;
next if m/^\#/os; # skip comment lines
next if m/^\s*$/os; # skip blank lines
if (m/^Category:\s*(.*?)\s*$/os) {
# Category? (should always be on top!)
$category = $1;
if (not defined($self->{'categories'}->{$category})) {
$self->{'categories'}->{$category} = [];
}
} elsif (m/^Question:\s*(.*?)\s*$/os) {
# Question (should always stand after Category)
$question = {'question' => $1, 'tip' => []};
if (defined($category)) {
$question->{'category'} = $category;
undef($category);
}
push(@{$self->{'questions'}}, $question);
push(@{$self->{'categories'}->{$category}}, $#{$self->{'questions'}});
} elsif (m/^Answer:\s*(?:(.*?)\#(.*?)\#(.*?)|(.*?))\s*$/os) {
# Answer (will be matched if no regexp is provided)
if (defined($1)) {
$question->{'answer-long'} = "$1$2$3";
$question->{'answer-short'} = $2;
} else {
$question->{'answer-long'} = $4;
$question->{'answer-short'} = $4;
}
} elsif (m/^Regexp:\s*(.*?)\s*$/os) {
# Regexp? (use UNIX-style expressions)
$question->{'answer-regexp'} = $1;
} elsif (m/^Author:\s*(.*?)\s*$/os) {
# Author? (the brain behind this question)
$question->{'author'} = $1;
} elsif (m/^Level:\s*(.*?)\s*$/os) {
# Level? [baby|easy|normal|hard|extreme] (difficulty)
$question->{'level'} = $1;
} elsif (m/^Comment:\s*(.*?)\s*$/os) {
# Comment? (comment line)
$question->{'comment'} = $1;
} elsif (m/^Score:\s*(.*?)\s*$/os) {
# Score? [#] (credits for answering this question)
$question->{'score'} = $1;
} elsif (m/^Tip:\s*(.*?)\s*$/os) {
# Tip* (provide one or more hints)
push(@{$question->{'tip'}}, $1);
} elsif (m/^TipCycle:\s*(.*?)\s*$/os) {
# TipCycle? [#] (Specify number of generated tips)
$question->{'tip-cycle'} = $1;
} else {
# XXX error handling
}
}
close(FILE);
} # else XXX invalid filename, ignore it
}
# if no more questions, abort running quizes.
if (not @{$self->{'questions'}}) {
foreach my $channel (keys %{$self->{'currentQuestion'}}) {
local $event->{'channel'} = $channel;
$self->say($event, 'There are no more questions.');
$self->quizEnd($event);
}
}
return scalar(@{$self->{'questions'}});
}
# game implementation
sub Scheduled {
my $self = shift;
my($event, @data) = @_;
if ($data[0] eq 'tip') {
if ($self->{'questionsTime'}->{$event->{'channel'}} == $data[1] and
defined($self->{'currentQuestion'}->{$event->{'channel'}})) {
# $self->debug('time for a tip');
if ($self->{'paused'}->{$event->{'channel'}} or
$self->quizTip($event)) {
$self->schedule($event, \$self->{'tipDelay'}, 1, @data);
}
}
} elsif ($data[0] eq 'timeout') {
if ($self->{'questionsTime'}->{$event->{'channel'}} == $data[1] and
defined($self->{'currentQuestion'}->{$event->{'channel'}})) {
if ($self->{'paused'}->{$event->{'channel'}}) {
$self->schedule($event, \$self->{'timeout'}, 1, @data);
} else {
my $answer = $self->{'questions'}->[$self->{'currentQuestion'}->{$event->{'channel'}}]->{'answer-long'};
$self->say($event, "Too late! The answer was: $answer");
$self->quizQuestion($event);
}
}
} elsif ($data[0] eq 'ask') {
if (defined($self->{'currentQuestion'}->{$event->{'channel'}})) {
$self->quizQuestion($event);
}
} else {
$self->SUPER::Scheduled($event, @data);
}
}
sub quizStart { # called by user
my $self = shift;
my($event) = @_;
if ($event->{'channel'} ne '' and
not defined($self->{'currentQuestion'}->{$event->{'channel'}})) {
if (@{$self->{'questions'}} == 0) {
# if no questions, complain.
$self->say($event, 'I cannot run a quiz with no questions!');
} else {
# no game in progress, start one
$self->{'remainingQuestions'}->{$event->{'channel'}} = $self->{'questionsPerRound'};
$self->{'paused'}->{$event->{'channel'}} = 0;
$self->{'quizTime'}->{$event->{'channel'}} = $event->{'time'};
$self->{'quizScores'}->{$event->{'channel'}} = '';
$self->{'players'}->{$event->{'channel'}} = '';
$self->quizQuestion($event);
}
}
}
sub quizQuestion { # called from quizStart or delayed from quizAnswer
my $self = shift;
my($event) = @_;
if ($event->{'channel'} ne '' and # in channel
not $self->{'paused'}->{$event->{'channel'}}) { # quiz not paused
if ($self->{'remainingQuestions'}->{$event->{'channel'}} != 0) {
$self->{'remainingQuestions'}->{$event->{'channel'}}--;
my $category = $self->{'questions'}->[$self->{'currentQuestion'}->{$event->{'channel'}}]->{'category'};
my $try = 0;
my $questionCount = scalar keys %{$self->{'questions'}};
while ($self->{'questions'}->[$self->{'currentQuestion'}->{$event->{'channel'}}]->{'category'} eq $category
and $try++ < $questionCount) {
$self->{'currentQuestion'}->{$event->{'channel'}} = $self->pickQuestion($event);
}
$self->{'questionsTime'}->{$event->{'channel'}} = $event->{'time'};
$self->{'tip'}->{$event->{'channel'}} = 0;
$self->{'skip'}->{$event->{'channel'}} = '';
$self->schedule($event, \$self->{'tipDelay'}, 1, 'tip', $self->{'questionsTime'}->{$event->{'channel'}});
$self->schedule($event, \$self->{'timeout'}, 1, 'timeout', $self->{'questionsTime'}->{$event->{'channel'}});
$self->say($event, "Question: $self->{'questions'}->[$self->{'currentQuestion'}->{$event->{'channel'}}]->{'question'}");
$self->debug("Question: $self->{'questions'}->[$self->{'currentQuestion'}->{$event->{'channel'}}]->{'question'}");
$self->debug("Answer: $self->{'questions'}->[$self->{'currentQuestion'}->{$event->{'channel'}}]->{'answer-long'}");
$self->saveConfig();
} else {
$self->quizEnd($event);
}
}
}
sub quizAnswer { # called by user
my $self = shift;
my($event, $message) = @_;
if ($event->{'channel'} ne '' and # in channel
defined($self->{'currentQuestion'}->{$event->{'channel'}}) and # in quiz
$self->{'questionsTime'}->{$event->{'channel'}} and # not answered
not $self->{'paused'}->{$event->{'channel'}}) { # quiz not paused
$self->stringHash(\$self->{'players'}->{$event->{'channel'}}, $event->{'from'}, $event->{'time'});
if (lc($message) eq lc($self->{'questions'}->[$self->{'currentQuestion'}->{$event->{'channel'}}]->{'answer-long'}) or
(defined($self->{'questions'}->[$self->{'currentQuestion'}->{$event->{'channel'}}]->{'answer-short'}) and
lc($message) eq lc($self->{'questions'}->[$self->{'currentQuestion'}->{$event->{'channel'}}]->{'answer-short'})) or
(defined($self->{'questions'}->[$self->{'currentQuestion'}->{$event->{'channel'}}]->{'answer-regexp'}) and
$message =~ /$self->{'questions'}->[$self->{'currentQuestion'}->{$event->{'channel'}}]->{'answer-regexp'}/si)) {
# they got it right
my $who = $event->{'from'};
my $answer = $self->{'questions'}->[$self->{'currentQuestion'}->{$event->{'channel'}}]->{'answer-long'};
my $score = $self->{'questions'}->[$self->{'currentQuestion'}->{$event->{'channel'}}]->{'score'};
if (not defined($score)) {
$score = 1; # use difficulty XXX
}
my $time = $event->{'time'} - $self->{'questionsTime'}->{$event->{'channel'}};
my $total = $self->score($event, $who, $score);
$self->debug("Answered by: $who");
$self->say($event, "$who got the right answer in $time seconds (+$score points giving $total). The answer was: $answer");
$self->saveConfig();
$self->{'questionsTime'}->{$event->{'channel'}} = 0;
$self->schedule($event, \$self->{'askDelay'}, 1, 'ask');
}
}
}
sub quizTip { # called by timer, only during game
my $self = shift;
my($event) = @_;
my $tip;
if (defined($self->{'questions'}->[$self->{'currentQuestion'}->{$event->{'channel'}}]->{'tips'}) and
$self->{'tip'}->{$event->{'channel'}} < @{$self->{'questions'}->[$self->{'currentQuestion'}->{$event->{'channel'}}]->{'tips'}}) {
$tip = $self->{'questions'}->[$self->{'currentQuestion'}->{$event->{'channel'}}]->{'tips'}->[$self->{'tip'}->{$event->{'channel'}}];
} else {
if (not defined($self->{'questions'}->[$self->{'currentQuestion'}->{$event->{'channel'}}]->{'tips'}) and
(not defined($self->{'questions'}->[$self->{'currentQuestion'}->{$event->{'channel'}}]->{'tipCycle'}) or
$self->{'tip'}->{$event->{'channel'}} < $self->{'questions'}->[$self->{'currentQuestion'}->{$event->{'channel'}}]->{'tipCycle'})) {
$tip = $self->generateTip($self->{'questions'}->[$self->{'currentQuestion'}->{$event->{'channel'}}]->{'answer-long'},
$self->{'tip'}->{$event->{'channel'}},
$self->{'questions'}->[$self->{'currentQuestion'}->{$event->{'channel'}}]->{'tipCycle'});
}
}
if (defined($tip)) {
$self->{'tip'}->{$event->{'channel'}} += 1;
$self->say($event, "Hint: $tip...");
$self->saveConfig();
return 1;
} else {
return 0;
}
}
sub quizPause { # called by user
my $self = shift;
my($event) = @_;
if (defined($self->{'currentQuestion'}->{$event->{'channel'}})) { # game in progress
if (not $self->{'paused'}->{$event->{'channel'}}) { # not paused
# pause game
$self->{'paused'}->{$event->{'channel'}} = 1;
$self->saveConfig();
$self->say($event, "Quiz paused. Use $self->{'prefix'}resume to continue.");
} else {
$self->say($event, "Quiz already paused. Use $self->{'prefix'}resume to continue.");
}
} else {
$self->say($event, "No quiz in progress, use $self->{'prefix'}ask to start one.");
}
}
sub quizResume { # called by user
my $self = shift;
my($event) = @_;
if (defined($self->{'currentQuestion'}->{$event->{'channel'}})) { # game in progress
if ($self->{'paused'}->{$event->{'channel'}}) { # paused
# unpause game
$self->{'paused'}->{$event->{'channel'}} = 0;
$self->saveConfig();
$self->say($event, "Quiz resumed. Question: $self->{'questions'}->[$self->{'currentQuestion'}->{$event->{'channel'}}]->{'question'}");
} else {
$self->say($event, "Quiz already in progress. Use $self->{'prefix'}repeat to be told the question again, and $self->{'prefix'}pause to pause the quiz.");
}
} else {
$self->say($event, "No quiz in progress, use $self->{'prefix'}ask to start one.");
}
}
sub quizRepeat { # called by user
my $self = shift;
my($event) = @_;
if (defined($self->{'currentQuestion'}->{$event->{'channel'}})) { # game in progress
$self->say($event, "Question: $self->{'questions'}->[$self->{'currentQuestion'}->{$event->{'channel'}}]->{'question'}");
} else {
$self->say($event, "No quiz in progress, use $self->{'prefix'}ask to start one.");
}
}
sub quizEnd { # called by question and user
my $self = shift;
my($event) = @_;
if (defined($self->{'currentQuestion'}->{$event->{'channel'}})) {
# get the scores for each player that player in the game
my @scores = $self->getScores($event, sub {
my($event, $score) = @_;
# XXX this means that a user has to be there till the end
# of the game to get points added to his high score table.
# XXX it also means a user can get better simply by
# playing more games.
$self->{'totalScores'}->{$score->[1]} += $score->[2];
});
# print them
if (@scores) {
local $" = ', ';
$self->say($event, "Quiz Ended. Scores: @scores");
} else {
$self->say($event, 'Quiz Ended. No questions were answered.');
}
delete($self->{'currentQuestion'}->{$event->{'channel'}});
$self->saveConfig();
}
}
sub quizScores { # called by user
my $self = shift;
my($event) = @_;
if (defined($self->{'currentQuestion'}->{$event->{'channel'}})) {
# get the scores for each player that player in the game
my @scores = $self->getScores($event, sub {});
# get other stats
my $remaining = '';
if ($self->{'remainingQuestions'}->{$event->{'channel'}} > 0) {
$remaining = " There are $self->{'remainingQuestions'}->{$event->{'channel'}} more questions to go.";
}
# print them
if (@scores) {
local $" = ', ';
$self->say($event, "Current Scores: @scores$remaining");
} else {
$self->say($event, "No questions have been answered yet.$remaining");
}
} else {
$self->say($event, "No quiz in progress, use $self->{'prefix'}ask to start one.");
}
}
sub quizSkip { # called by user
my $self = shift;
my($event) = @_;
if (defined($self->{'currentQuestion'}->{$event->{'channel'}})) { # game in progress
if (not $self->{'paused'}->{$event->{'channel'}}) { # not paused
if ($self->{'questionsTime'}->{$event->{'channel'}}) { # question asked and not answered
# XXX should only let players skip (at the moment even someone who has not tried to answer any question can skip)
# Get number of users who have said !skip (and set current user)
my(undef, $skipCount) = $self->stringHash(\$self->{'skip'}->{$event->{'channel'}}, $event->{'from'}, 1);
# Get number of users who are playing
my $playerCount = $self->getActivePlayers($event);
if ($skipCount >= $playerCount * $self->{'skipFractionRequired'}) {
my $answer = $self->{'questions'}->[$self->{'currentQuestion'}->{$event->{'channel'}}]->{'answer-long'};
$self->say($event, "$skipCount players wanted to skip. Moving to next question. The answer was: $answer");
$self->quizQuestion($event);
}
} # else drop it
} else {
$self->say($event, "Quiz paused. Use $self->{'prefix'}resume to continue the quiz.");
}
} else {
$self->say($event, "No quiz in progress, use $self->{'prefix'}ask to start one.");
}
}
sub pickQuestion {
my $self = shift;
my($event) = @_;
$self->{'questionIndex'} += 1 + $event->{'time'} % $self->{'skipMargin'};
$self->{'questionIndex'} %= @{$self->{'questions'}};
return $self->{'questionIndex'};
}
sub score {
my $self = shift;
my($event, $who, $score) = @_;
if (defined($self->{'currentQuestion'}->{$event->{'channel'}})) {
my($score, undef) = $self->stringHash(\$self->{'quizScores'}->{$event->{'channel'}}, $who, $score, 1);
$self->saveConfig();
return $score;
}
}
sub getScores {
my $self = shift;
my($event, $perUser) = @_;
my @scores;
foreach my $player ($self->getActivePlayers($event)) {
my($score, undef) = $self->stringHash(\$self->{'quizScores'}->{$event->{'channel'}}, $player);
if (defined($score)) {
push(@scores, ["$player: $score", $player, $score]);
}
}
# sort the scores by number
@scores = sort {$a->[2] <=> $b->[2]} @scores;
foreach my $score (@scores) {
&$perUser($event, $score);
$score = $score->[0];
}
return @scores;
}
sub generateTip {
my $self = shift;
my($answer, $tipID, $maxTips) = @_;
if (length($answer) > $tipID+1) {
return substr($answer, 0, $tipID+1);
} else {
return undef;
}
}
sub getActivePlayers {
my $self = shift;
my($event) = @_;
my @players;
if (defined($self->{'currentQuestion'}->{$event->{'channel'}})) { # game in progress
my $start = $self->{'quizTime'}->{$event->{'channel'}};
my %players = split(' ', $self->{'players'}->{$event->{'channel'}});
foreach my $player (keys %players) {
if ($players{$player} > $start) {
push(@players, $player);
}
}
}
return @players;
}
sub stringHash {
my $self = shift;
my($string, $key, $value, $multiple) = @_;
my %hash = split(' ', $$string);
my @hash;
if (defined($value)) {
if (defined($multiple)) {
$hash{$key} = $hash{$key} * $multiple + $value;
} else {
$hash{$key} = $value;
}
local $" = ' ';
@hash = %hash;
$$string = "@hash";
} else {
@hash = %hash;
}
return ($hash{$key}, scalar(@hash) / 2);
}

View File

@@ -1,651 +0,0 @@
# -*- Mode: perl; tab-width: 4; indent-tabs-mode: nil; -*-
################################
# Quotes Module #
################################
# Based on a request from Nortis http://www.blomstereng.org/
# XXX need to support multiple quote servers:
# !discworld
package BotModules::Quotes;
use vars qw(@ISA);
@ISA = qw(BotModules);
use Fcntl;
use DBI;
1;
# This uses a number of MySQL-specific features.
sub Help {
my $self = shift;
my ($event) = @_;
my $help = {
'' => 'A module to manage quotes.',
'quote' => 'Search for a quote, or return a random one. To search for a quote, you must specify search parameters, see the help entries for id, text, author, note, match. Otherwise, a random quote is returned.',
'match' => 'If there are multiple matches, you can specify which match you want by appending the match number to your search terms, for example \'quote author=blake 4\' will return the fourth quote whose author is \'blake\'. The default is 1.',
'id' => 'To search for a quote by its numeric ID, append the ID to the \'quote\' command. For example, \'quote 42\'. If you specify other search parameters, this will return the relevant match from that list, see the help entry for \'match\'.',
'text' => 'To search for a quote by text, append \'text="foo"\' to the \'quote\' command. For example, \'quote text="meaning of life"\' or \'quote text=life\'. You could also just say \'quote hello world\' or \'quote hello world 2\' (to get the second match).',
'author' => 'To search for a quote by author or attribution, append \'author="foo"\' to the \'quote\' command. For example, \'quote author="Douglas Adams"\' or \'quote author=asimov\'.',
'note' => 'To search for a quote by text in its note, append \'note="foo"\' to the \'quote\' command. For example, \'quote note=""\' or \'quote author=asimov\'.',
'quotelast' => 'Returns the last quote added. Append a numer to return the nth but last quote added, as in \'lastquote 2\'.',
'status' => 'Prints some information about the status of the quotes database.',
};
if ($self->canAdd($event)) {
$help->{'addquote'} = 'Add a quote to the database. The format is \'addquote quote - author (note)\'. The \'(note)\' part may be omitted. The author may not.';
}
if ($self->canDelete($event)) {
$help->{'delquote'} = 'Delete a quote from the database. The format is \'delquote id\'.';
}
if ($self->canEdit($event)) {
$help->{'editquote'} = 'Edit a quote in the database. The format is \'editquote id quote - author (note)\' which will update the quote with that ID, using the new text, author, etc, in the same way as for \'addquote\'.';
}
if ($self->isAdmin($event)) {
$help->{'setupquotes'} = 'Configure the quotes database connection. Format: \'setupquotes dbhost.example.com:dbport dbname dbuser dbpass\'. Port is optional (default 3306). You can also just say \'setupquotes\' to check on the configuration. See also \'help quote-defaults\'.';
$help->{'quote-defaults'} = 'To get the default configuration, use \'setupquotes mozbotquotes.damowmow.com:3306 mozbotquotes mozbotquotes mozbotquotes\'.';
}
return $help;
}
# RegisterConfig - Called when initialised, should call registerVariables
sub RegisterConfig {
my $self = shift;
$self->SUPER::RegisterConfig(@_);
$self->registerVariables(
# [ name, save?, settable? ]
['prefix', 1, 1, '!'], # the prefix to put before the undirected quote commands
['dbhost', 1, 1, 'mozbotquotes.damowmow.com'],
['dbport', 1, 1, '3306'],
['dbname', 1, 1, 'mozbotquotes'],
['dbuser', 1, 1, 'mozbotquotes'],
['dbpass', 1, 1, 'mozbotquotes'],
['tableName', 1, 1, 'quotes'],
['usersAdd', 1, 1, []],
['usersDelete', 1, 1, []],
['usersEdit', 1, 1, []],
);
}
# call this at the top of any function that uses tableName
sub sanitiseTableName {
my $self = shift;
$self->{tableName} =~ s/[^a-zA-Z]//gos;
if (length($self->{tableName}) < 1) {
$self->{tableName} = 'quotes';
}
$self->saveConfig();
}
sub canAdd {
my $self = shift;
return $self->checkRights('Add', @_);
}
sub canDelete {
my $self = shift;
return $self->checkRights('Delete', @_);
}
sub canEdit {
my $self = shift;
return $self->checkRights('Edit', @_);
}
sub checkRights {
my $self = shift;
my ($right, $event) = @_;
return 1 if $self->isAdmin($event);
foreach my $user (@{$self->{"users$right"}}) {
return 1 if $user eq $event->{userName};
}
return 0;
}
sub Schedule {
my $self = shift;
my ($event) = @_;
unless ($self->dbconnect()) {
$self->say($event, "Failed to connect to quotes database: $self->{dberror}");
$self->say($event, 'Use the \'setupquotes\' command to configure the database.');
}
$self->SUPER::Schedule($event);
}
sub dbconnect {
my $self = shift;
eval {
$self->{dbhandle} =
DBI->connect("DBI:mysql:$self->{dbname}:$self->{dbhost}:$self->{dbport}",
$self->{dbuser}, $self->{dbpass},
{RaiseError => 1, PrintError => 1, AutoCommit => 1, Taint => 0});
};
if (not $self->{dbhandle}) {
$self->{dberror} = $@;
$self->debug("Failed to connect to quotes database: $self->{dberror}");
return 0;
}
return 1;
}
sub dbdisconnect {
my $self = shift;
my ($event) = @_;
if ($self->{dbhandle}) {
$self->{dbhandle}->disconnect();
$self->{dbhandle} = undef;
}
}
sub Unload {
my $self = shift;
my ($event) = @_;
$self->dbdisconnect($event);
}
sub dbcheckconfig {
my $self = shift;
my ($event) = @_;
$self->sanitiseTableName();
# count tables
my $tables = $self->{dbhandle}->selectall_arrayref('SHOW TABLES');
my $wantedTable = undef;
$tables = [] unless defined $tables;
foreach (@$tables) {
$_ = $_->[0];
}
if (@$tables == 1) {
# if only one, assume that's the one we want to use
$wantedTable = $tables->[0];
} else {
# otherwise, assume the name is 'quotes'
$wantedTable = $self->{tableName} || 'quotes';
}
# check table exists
$self->{dbtables} = $tables;
foreach my $table (@$tables) {
if (lc $table eq lc $wantedTable) {
$self->{tableName} = $table;
$self->saveConfig();
return 1;
}
}
return 0;
}
sub dbcreatetables {
my $self = shift;
my ($event) = @_;
$self->sanitiseTableName();
# create table
eval {
$self->{dbhandle}->do("CREATE TABLE IF NOT EXISTS $self->{tableName} (
id INTEGER UNSIGNED NOT NULL AUTO_INCREMENT PRIMARY KEY,
quote TEXT NOT NULL DEFAULT '',
author VARCHAR(100) NOT NULL DEFAULT 'Unknown',
date DATETIME NOT NULL DEFAULT 0,
note TEXT NULL DEFAULT NULL,
shown INTEGER UNSIGNED NOT NULL DEFAULT 0,
age INTEGER UNSIGNED NOT NULL DEFAULT 1,
INDEX (author), INDEX(shown), INDEX(age)
)");
};
if ($@) {
$self->{dberror} = $@;
$self->debug("Failed to create quotes table: $self->{dberror}");
return 0;
}
return 1;
}
sub verifyConnection {
my $self = shift;
my ($event) = @_;
if ($self->dbconnect()) {
if (not $self->dbcheckconfig($event)) {
if (@{$self->{dbtables}}) {
local $" = '\', \'';
$self->say($event, "Connected, but I there were several tables and I wasn't sure which to use. The tables in this database are: '@{$self->{dbtables}}'");
$self->say($event, "To make me create a new table (called '$self->{tableName}') use 'setupquotes table'. To make me use a particular table from the list above, use 'setupquotes use table $self->{dbtables}->[0]' (or whatever table you want to use).");
} else {
$self->say($event, "Connected, but I couldn't find a quotes table in the database. If you want me to create a table (named '$self->{tableName}') for you, use 'setupquotes tables'. To create one with a specific name, e.g. 'mozQuotes', use 'setupquotes tables mozQuotes'.");
}
} else {
$self->say($event, "Connected (using table '$self->{tableName}').");
}
} else {
$self->say($event, "Failed to connect to quotes database: $self->{dberror}");
}
}
sub Told {
my $self = shift;
my ($event, $message) = @_;
if ($message =~ /^\s*set\s*up\s*quotes?(?:\s+(.*?))?\s*$/osi and $self->isAdmin($event)) {
my $data = $1;
if ($data =~ m/^(\S+?)(?::(\S+))?\s+(\S+)\s+(\S+)\s+(\S+)$/osi) {
$self->dbdisconnect($event);
$self->{'dbhost'} = $1;
$self->{'dbport'} = $2 || 3306;
$self->{'dbname'} = $3;
$self->{'dbuser'} = $4;
$self->{'dbpass'} = $5;
$self->saveConfig();
$self->say($event, "Ok, trying to connect...");
$self->verifyConnection($event);
} elsif ($data =~ m/^tables?(?:\s+(\S+))?$/osi) {
if ($self->{dbhandle}) {
if ($1) {
$self->{tableName} = $1;
$self->sanitiseTableName();
}
if ($self->dbcreatetables($event)) {
$self->say($event, "Connected (using table '$self->{tableName}').");
} else {
$self->say($event, "Failed to create the table ('$self->{dberror}') -- make sure you have the right permissions set up.");
}
} else {
$self->say($event, 'I haven\'t yet successfully connected to a database. Please select a MySQL server to connect to, e.g. \'setupquotes mozbotquotes.damowmow.com:3306 mozbotquotes mozbotquotes mozbotquotes\'');
}
} elsif ($data =~ m/^use\s*tables?\s+(\S+)$/osi) {
$self->{tableName} = $1;
$self->sanitiseTableName();
if ($self->{dbhandle}) {
if (not $self->dbcheckconfig($event)) {
if (@{$self->{dbtables}}) {
local $" = '\', \'';
$self->say($event, "The table you requested, '$self->{tableName}', doesn't exist in this database. The tables in this database are: '@{$self->{dbtables}}'");
$self->say($event, "To make me create this new table (called '$self->{tableName}') use 'setupquotes table'. To make me use one of the tables from the list above, use 'setupquotes use table $self->{dbtables}->[0]' (or whatever table you want to use).");
} else {
$self->say($event, "The table you requested, '$self->{tableName}', doesn't exist in this database. In fact this database has no tables at all. If you want me to create a table (called '$self->{tableName}') for you, use 'setupquotes tables'.");
}
} else {
$self->say($event, "Connected (using table '$self->{tableName}').");
}
} else {
$self->say($event, 'Noted. However, I haven\'t yet successfully connected to a database, so this is not enough to complete configuration.');
$self->say($event, 'Please select a MySQL server to connect to, e.g. \'setupquotes mozbotquotes.damowmow.com:3306 mozbotquotes mozbotquotes mozbotquotes\'');
}
} elsif ($data =~ m/^\s*$/osi) {
$self->dbdisconnect($event);
$self->say($event, "Checking connection...");
$self->verifyConnection($event);
} else {
$self->say($event, 'The format is: \'setupquotes host.domain.tld:port database username password\' (\':port\' is optional, defaults to 3306) or just \'setupquotes\' to check the configuration.');
}
} elsif ($message =~ /^\s*quote(?:\s+(.+?))?\s*$/osi) {
$self->getQuote($event, $1);
} elsif ($message =~ /^\s*(?:quotelast|last\s*quote)(?:\s+(.+?))?\s*$/osi) {
$self->getLastQuote($event, $1);
} elsif ($message =~ /^\s*add\s*quote(?:\s+(.+?))?\s*$/osi) {
$self->addQuote($event, $1);
} elsif ($message =~ /^\s*(?:delete|del|remove|rem)?\s*quote(?:\s+(.+?))?\s*$/osi) {
$self->deleteQuote($event, $1);
} elsif ($message =~ /^\s*edit\s*quote(?:\s+(.+?))?\s*$/osi) {
$self->editQuote($event, $1);
} elsif ($message =~ /^\s*(?:quotes?\s*)?status\s*$/osi) {
$self->printStatus($event);
} elsif ($self->checkBangCommands(@_)) {
return $self->SUPER::Told(@_);
}
return 0; # we've dealt with it, no need to do anything else.
}
sub Heard {
my $self = shift;
if ($self->checkBangCommands(@_)) {
return $self->SUPER::Heard(@_);
}
return 0; # we've dealt with it, no need to do anything else.
}
sub checkBangCommands {
my $self = shift;
my ($event, $message) = @_;
if ($message =~ /^$self->{prefix}quote(?:\s+(.+?))?\s*$/si) {
$self->getQuote($event, $1);
} elsif ($message =~ /^$self->{prefix}(?:quotelast|lastquote)(?:\s+(.+?))?\s*$/si) {
$self->getLastQuote($event, $1);
} elsif ($message =~ /^$self->{prefix}addquote(?:\s+(.+?))?\s*$/si) {
$self->addQuote($event, $1);
} elsif ($message =~ /^$self->{prefix}delquote(?:\s+(.+?))?\s*$/si) {
$self->deleteQuote($event, $1);
} elsif ($message =~ /^$self->{prefix}editquote(?:\s+(.+?))?\s*$/si) {
$self->editQuote($event, $1);
} else {
return 1; # nope
}
return 0; # we've dealt with it, no need to do anything else.
}
sub markRead {
my $self = shift;
my ($id) = @_;
eval {
$self->{dbhandle}->do("UPDATE $self->{tableName} SET shown = shown + 1 WHERE id = ?", undef, $id);
$self->{dbhandle}->do("UPDATE $self->{tableName} SET age = age + 1");
};
# ignore errors (don't have to worry about timeouts, this is only
# ever done after recent db access)
}
sub getQuote {
my $self = shift;
my ($event, $data) = @_;
if (not $self->{dbhandle}) {
$self->say($event, "$event->{from}: I haven't got a connection to a database yet, sorry.");
return;
}
if (defined $data) {
if ($data =~ m/^\s*([0-9]+)\s*$/os) {
$self->getQuoteById($event, $1);
} else {
$self->searchQuote($event, $data);
}
} else {
$self->randomQuote($event);
}
}
sub randomQuoteInternal {
my $self = shift;
my ($event) = @_;
my($id, $quote, $author, $note);
return 0 unless $self->attempt($event, sub { ($id, $quote, $author, $note) = $self->{dbhandle}->selectrow_array("SELECT id, quote, author, note, shown/age AS freq FROM $self->{tableName} ORDER BY freq, RAND() LIMIT 1", undef); }, 'read from the database for some reason', 'read a random quote from');
if (defined $quote) {
$self->markRead($id);
$note = defined $note ? " ($note)" : '';
$self->say($event, "Quote $id: $quote - $author$note");
return 0;
}
return 1; # try again
}
sub randomQuote {
my $self = shift;
my ($event) = @_;
$self->sanitiseTableName();
if ($self->randomQuoteInternal($event)) {
# no quotes?
# weird... let's see if reconnecting helps
if ($self->dbconnect()) {
if ($self->randomQuoteInternal($event)) {
# there must really be no quotes
$self->say($event, "$event->{from}: There are no quotes in the database yet.");
} # else ok
} else {
$self->say($event, "$event->{from}: I'm sorry, I can't reach the database right now.");
$self->tellAdmin($event, "While trying to get a random quote from the database, I found no quotes, so I tried reconnecting to the database, but it said '$self->{dberror}'!");
}
} # else ok
}
sub getQuoteById {
my $self = shift;
my ($event, $id, $action) = @_;
$self->sanitiseTableName();
my($quote, $author, $note);
return unless $self->attempt($event, sub {
($quote, $author, $note) = $self->{dbhandle}->selectrow_array("SELECT quote, author, note FROM $self->{tableName} WHERE id=?", undef, $id);
}, 'read from the database for some reason', 'read a quote from');
if (defined $quote) {
$self->markRead($id);
$note = defined $note ? " ($note)" : '';
$action = defined $action ? "$action: " : '';
$self->say($event, "\u${action}Quote $id: $quote - $author$note");
} elsif (defined $action) {
return 0;
} else {
$self->say($event, "$event->{from}: There is no quote with ID $id as far as I can tell.");
}
return 1;
}
sub searchQuote {
my $self = shift;
my ($event, $data) = @_;
# [author=""] [text=""] [note=""] [text] [n]
my (@columns, @values);
my $skip = 0;
while (length $data) {
if ($data =~ s/^\s*text="([^"]*)"(?:\s|\z)//osi or
$data =~ s/^\s*text='([^']*)'(?:\s|\z)//osi or
$data =~ s/^\s*text=(\S+)(?:\s|\z)//osi) {
push(@columns, 'quote LIKE ?');
push(@values, "%$1%");
} elsif ($data =~ s/^\s*author="([^"]*)"(?:\s|\z)//osi or
$data =~ s/^\s*author='([^']*)'(?:\s|\z)//osi or
$data =~ s/^\s*author=(\S+)(?:\s|\z)//osi) {
push(@columns, 'author LIKE ?');
push(@values, "%$1%");
} elsif ($data =~ s/^\s*note="([^"]*)"(?:\s|\z)//osi or
$data =~ s/^\s*note='([^']*)'(?:\s|\z)//osi or
$data =~ s/^\s*note=(\S+)(?:\s|\z)//osi) {
push(@columns, 'note LIKE ?');
push(@values, "%$1%");
} elsif ($data =~ s/^\s*(\w+)="([^"]*)"(?:\s|\z)//osi or
$data =~ s/^\s*(\w+)='([^']*)'(?:\s|\z)//osi or
$data =~ s/^\s*(\w+)=(\S+)(?:\s|\z)//osi) {
$self->say($event, "$event->{from}: I don't know how to search for '$1'. The valid search types are 'author', 'note', and 'text'. See the help entry for 'quote' for more information on the quote searching syntax.");
return;
} elsif ($data =~ s/^\s*([0-9]+)\s*$//osi) {
$skip = $1 - 1;
} elsif ($data =~ s/^\s*"([^"]+)"(?:\s|\z)//osi or
$data =~ s/^\s*'([^']+)'(?:\s|\z)//osi or
$data =~ s/^\s*(\S+)(?:\s|\z)//osi) {
push(@columns, 'quote LIKE ?');
push(@values, "%$1%");
} else {
# wtf
$self->say($event, "$event->{from}: I didn't quite understand what you were looking for ('$data'?). See the help entry for 'quote' for more information on the quote searching syntax.");
return;
}
}
$self->sanitiseTableName();
my($id, $count, $quote, $author, $note);
return unless $self->attempt($event, sub {
local $" = ' AND ';
($count) = $self->{dbhandle}->selectrow_array("SELECT COUNT(*) FROM $self->{tableName} WHERE @columns", undef, @values);
($id, $quote, $author, $note) = $self->{dbhandle}->selectrow_array("SELECT id, quote, author, note FROM $self->{tableName} WHERE @columns LIMIT $skip,1", undef, @values);
}, 'read from the database for some reason', 'search for a quote in');
if (defined $quote) {
$self->markRead($id);
$note = defined $note ? " ($note)" : '';
my $n = $skip + 1;
$count = "about $n" if $count < $n; # sanitise output in case of race condition
my $match = $count == 1 ? 'only match' : "match $n of $count";
$self->say($event, "Quote $id ($match): $quote - $author$note");
} else {
$self->say($event, "$event->{from}: No matching quotes found.");
}
}
sub getLastQuote {
my $self = shift;
my ($event, $data) = @_;
if (not $self->{dbhandle}) {
$self->say($event, "$event->{from}: I haven't got a connection to a database yet, sorry.");
return;
}
if ($data !~ m/^\s*([0-9]+)?\s*$/os) {
$self->say($event, "$event->{from}: The syntax is 'lastquote 2', where 2 is the number of the quote to show (counting from the end). You can omit the number to get the last quote added.");
return;
}
my $skip = ($1 || 1) - 1;
$self->sanitiseTableName();
my($id, $quote, $author, $note);
return unless $self->attempt($event, sub {
($id, $quote, $author, $note) = $self->{dbhandle}->selectrow_array("SELECT id, quote, author, note FROM $self->{tableName} ORDER BY id DESC LIMIT $skip,1", undef);
}, 'read from the database for some reason', 'read the last few quotes from the database');
if (defined $quote) {
$self->markRead($id);
$note = defined $note ? " ($note)" : '';
$self->say($event, "Quote $id: $quote - $author$note");
} else {
$self->say($event, "$event->{from}: There are no quotes in the database yet.");
}
}
sub addQuote {
my $self = shift;
my ($event, $data) = @_;
if (not $self->canAdd($event)) {
$self->say($event, "$event->{from}: You are not allowed to add quotes, sorry.");
return;
}
if (not $self->{dbhandle}) {
$self->say($event, "$event->{from}: I haven't got a connection to a database yet, sorry.");
return;
}
# quote - author (note)
if ($data =~ m/^ (.+\S)
\s* - \s*
(.+?)
(?:\s+\((.+)\))?
$/osx) {
my $quote = $1;
my $author = $2;
my $note = $3;
# insert data
$self->sanitiseTableName();
return unless $self->attempt($event, sub {
$self->{dbhandle}->do("INSERT INTO $self->{tableName} SET
quote = ?, author = ?, date = NOW(), note = ?",
undef, $quote, $author, $note);
my $id = $self->{dbhandle}->{mysql_insertid};
if (not $self->getQuoteById($event, $id, 'inserted')) {
$self->say($event, "$event->{from}: Your quote disappeared after I inserted it into the database. You may wish to speak to the other people who have access to the quotes database about this... :-)");
}
}, 'seem to add that quote to the database.', 'add a quote to');
} else {
$self->say($event, "$event->{from}: The syntax for adding a quote is 'quote - author' or 'quote - author (note)'.");
}
}
sub deleteQuote {
my $self = shift;
my ($event, $data) = @_;
if (not $self->canDelete($event)) {
$self->say($event, "$event->{from}: You are not allowed to delete quotes, sorry.");
return;
}
if (not $self->{dbhandle}) {
$self->say($event, "$event->{from}: I haven't got a connection to a database yet, sorry.");
return;
}
if ($data !~ m/^\s*([0-9]+)\s*$/os) {
$self->say($event, "$event->{from}: The syntax is 'delquote 5', where 5 is the id of the quote to delete.");
return;
}
my $id = $1;
$self->sanitiseTableName();
my($quote, $author, $note);
return unless $self->attempt($event, sub {
($quote, $author, $note) = $self->{dbhandle}->selectrow_array("SELECT quote, author, note FROM $self->{tableName} WHERE ID=?", undef, $id);
}, 'read from the database for some reason', 'read a quote to delete from');
if (defined $quote) {
return unless $self->attempt($event, sub {
$self->{dbhandle}->do("DELETE FROM $self->{tableName} WHERE ID=?", undef, $id);
}, 'delete from the database. Maybe I don\'t have enough privileges on the database server', 'delete from');
$note = defined $note ? " ($note)" : '';
$self->say($event, "Deleted: Quote $id: $quote - $author$note");
} else {
$self->say($event, "$event->{from}: There is no quote with ID $id as far as I can tell.");
}
}
sub editQuote {
my $self = shift;
my ($event, $data) = @_;
if (not $self->canEdit($event)) {
$self->say($event, "$event->{from}: You are not allowed to edit quotes, sorry.");
return;
}
if (not $self->{dbhandle}) {
$self->say($event, "$event->{from}: I haven't got a connection to a database yet, sorry.");
return;
}
if ($data =~ m/^ ([0-9]+) \s+
(.+\S)
\s* - \s*
(.+?)
(?:\s+\((.+)\))?
$/osx) {
my $id = $1;
my $quote = $2;
my $author = $3;
my $note = $4;
# insert data
$self->sanitiseTableName();
return unless $self->attempt($event, sub {
$self->{dbhandle}->do("UPDATE $self->{tableName} SET
quote = ?, author = ?, note = ?
WHERE id = ?",
undef, $quote, $author, $note, $id);
if (not $self->getQuoteById($event, $id, 'edited')) {
$self->say($event, "$event->{from}: I couldn't find a quote with ID $id.");
}
}, 'seem to edit that quote', 'edit a quote in');
} else {
$self->say($event, "$event->{from}: The syntax for editing a quote is 'id quote - author' or 'id quote - author (note)', much like for adding a quote but with the id of the quote to edit at the start.");
}
}
sub printStatus {
my $self = shift;
my ($event) = @_;
if (not $self->{dbhandle}) {
$self->say($event, "$event->{from}: No connection could be established to the quotes datbase.");
return;
}
$self->sanitiseTableName();
my ($quotes, $sources, $shown, $id) = @_;
return unless $self->attempt($event, sub {
($quotes, $sources, $shown) = $self->{dbhandle}->selectrow_array("SELECT COUNT(*), COUNT(DISTINCT author), SUM(shown) FROM $self->{tableName}");
($id) = $self->{dbhandle}->selectrow_array("SELECT id, shown/age AS freq FROM $self->{tableName} ORDER BY freq, shown LIMIT 1");
}, 'connect to the quotes database', 'obtain statistics of');
if ($quotes) {
my $s1 = $quotes == 1 ? '' : 's';
my $s2 = $sources == 1 ? '' : 's';
my $s3 = $shown == 1 ? '' : 's';
$self->say($event, "$event->{from}: The database contains $quotes quote$s1 attributed to $sources source$s2. I have shown these quotes $shown time$s3 in total. The most popular quote (relatively speaking) is quote ID $id.");
} else {
$self->say($event, "$event->{from}: The database contains 0 quotes.");
}
}
sub attempt {
my $self = shift;
my($event, $sub, $action1, $action2) = @_;
eval { &$sub };
if ($@) {
chomp $@;
my $error = $@;
# A common error is:
# "DBD::mysql::db selectrow_array failed: MySQL server has
# gone away at (eval 34) line 357."
# ...so we try to reconnect and do it again
if ($self->dbconnect()) {
eval { &$sub };
if ($@) {
chomp $@;
$self->say($event, "$event->{from}: I'm sorry, I can't $action1.");
if ($@ eq $error) {
$self->tellAdmin($event, "While trying to $action2 the database, I got '$@'. I tried reconnecting but that didn't help.");
} else {
$self->tellAdmin($event, "While trying to $action2 the database, I got '$error'. Then I tried reconnecting and it worked but when I tried to $action2 the database a second time, it said '$@'.");
}
return 0;
}
} else {
$self->say($event, "$event->{from}: I'm sorry, I can't $action1.");
$self->tellAdmin($event, "While trying to $action2 the database, I got '$error', so I tried reconnecting to the database but I got '$self->{dberror}'. Help!");
return 0;
}
}
return 1;
}

View File

@@ -1,268 +0,0 @@
################################
# RDF Module #
################################
# this is really an RSS module, not an RDF module.
# but oh well.
package BotModules::RDF;
use XML::RSS;
use vars qw(@ISA);
@ISA = qw(BotModules);
1;
# RegisterConfig - Called when initialised, should call registerVariables
sub RegisterConfig {
my $self = shift;
$self->SUPER::RegisterConfig(@_);
$self->registerVariables(
# [ name, save?, settable? ]
['sites', 1, 1, {}],
['updateDelay', 1, 1, 600],
['preferredLineLength', 1, 1, 80],
['maxInChannel', 1, 1, 5],
['maxLines', 1, 1, 20],
['trimTitles', 1, 1, '0'],
['data', 0, 0, {}], # data -> uri -> (title, link, last, items -> uri)
['mutes', 1, 1, {}], # uri -> "channel channel channel"
);
}
# Schedule - called when bot connects to a server, to install any schedulers
# use $self->schedule($event, $delay, $times, $data)
# where $times is 1 for a single event, -1 for recurring events,
# and a +ve number for an event that occurs that many times.
sub Schedule {
my $self = shift;
my ($event) = @_;
$self->schedule($event, \$self->{'updateDelay'}, -1, 'rdf');
$self->SUPER::Schedule($event);
}
sub Help {
my $self = shift;
my ($event) = @_;
my %commands;
if ($self->isAdmin($event)) {
$commands{''} = "The RDF module monitors various websites. Add new RDF channels to the 'sites' hash. Duplicates with different nicknames are fine. For example, \"vars $self->{'_name'} sites '+|slashdot|http://...'\" and \"vars $self->{'_name'} sites '+|/.|http://...'\" is fine. To remove a site from the RDF 'sites' hash, use this syntax \"vars $self->{_name} sites '-slashdot'";
$commands{'mute'} = 'Disable reporting of a site in a channel. (Only does something if the given site exists.) Syntax: mute <site> in <channel>';
$commands{'unmute'} = 'Enable reporting of a site in a channel. By default, sites are reported in all channels that the module is active in. Syntax: unmute <site> in <channel>';
} else {
$commands{''} = 'The RDF module monitors various websites.';
}
foreach my $site (keys(%{$self->{'sites'}})) {
if ($self->{'data'}->{$self->{'sites'}->{$site}}) {
$commands{$site} = "Reports the headlines listed in $self->{'data'}->{$self->{'sites'}->{$site}}->{'title'}";
# -- #mozilla was here --
# <Hixie> anyway, $self->{'data'}->{$self->{'sites'}->{$site}}->{'title'} is
# another nice piece of perl (embedded in a quoted string in this case)
# <moogle> yeah, that's a bit more familiar
# <jag> Oooh, nice one
# <jag> Reminds me of Java, a bit :-)
# <jag> Without all the casting about from Object to Hashtable
# <Hixie> all this, BTW, is from the RDF module (the one that mozbot uses to
# report changes in mozillazine and so on)
# <moogle> I still tend to comment these things a bit just for maintainability
# by others who might not wish to do mental gymnastics :)
# <Hixie> :-)
} else {
$commands{$site} = "Reports the headlines listed in $self->{'sites'}->{$site}";
}
}
return \%commands;
}
sub Told {
my $self = shift;
my ($event, $message) = @_;
foreach my $site (keys(%{$self->{'sites'}})) {
if ($message =~ /^\s*(\Q$site\E)\s*$/si) {
$self->GetSite($event, $1, 'request');
return 0; # dealt with it...
}
}
if ($self->isAdmin($event)) {
if ($message =~ /^\s*mute\s+(\S+?)\s+in\s+(\S+?)\s*$/osi) {
my $site = $1 eq 'RDF' ? '' : $self->{'sites'}->{$1};
my $siteName = $site eq '' ? 'all sites' : $site;
if (defined($site)) {
$self->{'mutes'}->{$site} .= " $2";
$self->saveConfig();
$self->say($event, "$event->{'from'}: RDF notifications for $siteName muted in channel $2.");
} else {
# can't say this, other modules might recognise it: $self->say($event, "$event->{'from'}: I don't know about any '$1' site...");
}
} elsif ($message =~ /^\s*unmute\s+(\S+?)\s+in\s+(\S+?)\s*$/osi) {
my $site = $1 eq 'RDF' ? '' : $self->{'sites'}->{$1};
my $siteName = $site eq '' ? 'all sites' : $site;
if (defined($site)) {
my %mutedChannels = map { lc($_) => 1 } split(/ /o, $self->{'mutes'}->{$site});
delete($mutedChannels{lc($2)}); # get rid of any mentions of that channel
$self->{'mutes'}->{$site} = join(' ', keys(%mutedChannels));
$self->saveConfig();
$self->say($event, "$event->{'from'}: RDF notifications for $siteName resumed in channel $2.");
} else {
# can't say this, other modules might recognise it: $self->say($event, "$event->{'from'}: I don't know about any '$1' site...");
}
} else {
return $self->SUPER::Told(@_);
}
} else {
return $self->SUPER::Told(@_);
}
return 0;
}
sub GetSite {
my $self = shift;
my ($event, $site, $intent) = @_;
if (defined($self->{'sites'}->{$site})) {
my $uri = $self->{'sites'}->{$site};
$self->getURI($event, $uri, $intent);
} else {
# XXX
}
}
sub GotURI {
my $self = shift;
my ($event, $uri, $output, $intent) = @_;
$self->{'data'}->{$uri}->{'ready'} = defined($self->{'data'}->{$uri});
if ($output) {
# last update stamp
my $last = $event->{'time'};
$self->{'data'}->{$uri}->{'last'} = $last;
# Parse It
my $rss = XML::RSS->new();
eval { $rss->parse($output) };
if ($@) {
$self->debug("$uri is not a valid RSS file");
if ($intent eq 'request') {
$self->say($event, "$event->{'from'}: Dude, the file is not valid RSS! ($uri)");
}
return;
}
# Set Link and Title
$self->{data}->{$uri}->{'link'} = $rss->{'channel'}->{'link'};
$self->{data}->{$uri}->{'title'} = $rss->{'channel'}->{'title'};
foreach my $item (@{$rss->{'items'}}) {
unless (($item->{title} =~ /^last update/osi) ||
(defined($self->{'data'}->{$uri}->{'items'}->{$item->{'title'}}))) {
$self->{'data'}->{$uri}->{'items'}->{$item->{'title'}} = $last;
}
}
$self->ReportDiffs($event, $uri, $intent);
if ($intent eq 'request') {
$self->ReportAll($event, $uri);
}
} else {
if ($intent eq 'request') {
$self->say($event, "$event->{'from'}: Dude, the file was empty! ($uri)");
}
}
}
sub Scheduled {
my $self = shift;
my ($event, @data) = @_;
if ($data[0] eq 'rdf') {
my %sites = map { $_ => 1 } values(%{$self->{'sites'}});
foreach (keys(%sites)) {
$self->getURI($event, $_, 'update');
}
} else {
$self->SUPER::Scheduled($event, @data);
}
}
sub ReportDiffs {
my $self = shift;
my ($event, $uri, $request) = @_;
return unless $self->{'data'}->{$uri}->{'ready'};
my $last = $self->{'data'}->{$uri}->{'last'};
my @output;
foreach (keys(%{$self->{'data'}->{$uri}->{'items'}})) {
push(@output, $_) if ($self->{'data'}->{$uri}->{'items'}->{$_} == $last);
}
# -- #mrt was here --
# <mozbot> Friday's security advisories -- The first stable
# Xen release -- Linux Gazette #95
# <mozbot> KDE Under The Microscope -- Additional OpenSSL info
# <Hixie> wtf
# <mozbot> Just appeared in jbisbee.com -
# http://www.jbisbee.com/ : PoCo::RSS::Aggregator
# <Hixie> why is it repeating the same thing over and over
# <mozbot> PoCo::RSSAggregator & XML::RSS::Feed Uploaded to
# CPAN -- More PoCo::RSSAggregator
# <Hixie> mozbot: shutup please
# <mozbot> Ok, threw away 2558 messages.
# Ahem. So now we limit the diff reporting code to maxInChannel
# items at a time...
if (@output and @output < $self->{'maxInChannel'}) {
my %mutedChannels = ();
if (defined($self->{'mutes'}->{$uri})) {
%mutedChannels = map { lc($_) => 1 } split(/\s+/os, $self->{'mutes'}->{$uri});
}
if (defined($self->{'mutes'}->{''})) {
%mutedChannels = (%mutedChannels, map { lc($_) => 1 } split(/\s+/os, $self->{'mutes'}->{''}));
}
if ($request eq 'request') {
$mutedChannels{$event->{'channel'}} = 1;
}
foreach (@{$self->{'channels'}}) {
unless ($mutedChannels{$_}) {
local $event->{'target'} = $_;
$self->say($event, "Just appeared in $self->{'data'}->{$uri}->{'title'} - $self->{'data'}->{$uri}->{'link'} :");
foreach (@output) {
$self->say($event, " " . $_);
}
}
}
}
}
sub ReportAll {
my $self = shift;
my ($event, $uri) = @_;
my @output;
foreach (keys(%{$self->{'data'}->{$uri}->{'items'}})) {
push(@output, $_);
}
@output = $self->prettyPrint($self->{'preferredLineLength'},
"Items in $self->{'data'}->{$uri}->{'title'} - $self->{'data'}->{$uri}->{'link'}: ",
"$event->{'from'}: ", ' -- ', @output);
if (@output > $self->{'maxLines'}) {
splice(@output, $self->{'maxLines'} + 1);
unshift(@output, "The list is longer than $self->{'maxLines'}"
. " lines, only the first $self->{'maxLines'} will be shown.");
}
if (@output > $self->{'maxInChannel'}) {
foreach (@output) {
$self->directSay($event, $_);
}
$self->channelSay($event, "$event->{'from'}: /msg'ed");
} else {
foreach (@output) {
$self->say($event, $_);
}
}
}

View File

@@ -1,94 +0,0 @@
################################
# Rude Module #
################################
# This module implements the same functionality as Insult.bm and
# Excuse.bm but using remote servers. Those servers are currently (and
# probably forever) down. This module is therefore mainly here for
# historical interest, and may be removed from future distributions.
# If you use, or need, this module, please let me know. - ian@hixie.ch
package BotModules::Rude;
use vars qw(@ISA);
use Net::Telnet;
@ISA = qw(BotModules);
1;
sub Help {
my $self = shift;
my ($event) = @_;
return {
'' => 'The Rude Module is... rude. Very rude! So rude!!!',
'insult' => 'Insults someone. Syntax: \'insult <who>\'',
'excuse' => 'Gives you an excuse for the system being down. Syntax: \'excuse\'',
};
}
# -- timeless was here --
# <timeless> Rude module is missing a jar jar quote ~how wude~
# RegisterConfig - Called when initialised, should call registerVariables
sub RegisterConfig {
my $self = shift;
$self->SUPER::RegisterConfig(@_);
$self->registerVariables(
# [ name, save?, settable? ]
['insultHost', 1, 1, 'insulthost.colorado.edu'],
['insultPort', 1, 1, '1695'],
['excuseHost', 1, 1, 'bofh.engr.wisc.edu'], # same host as bofh.jive.org
['excusePort', 1, 1, '666'],
['insultOverrides', 1, 1, { # overrides for the insults (keys must be lowercase)
'mozilla' => 'You are nothing but the best browser on the planet.',
'mozilla.org' => 'You are nothing but the best caretaker Mozilla ever had.',
'c++' => 'you are evil',
}],
);
}
sub Told {
my $self = shift;
my ($event, $message) = @_;
if ($message =~ /^\s*(?:will\s+you\s+)?(?:insult|harass)\s+(\S+?)(?:[\s,.]+please)?[\s.?!]*$/osi) {
my $line;
if (defined($self->{'insultOverrides'}->{lc $1})) {
$line = "$1: ".$self->{'insultOverrides'}->{lc $1};
} else {
eval {
my $t = new Net::Telnet (Timeout => 3);
$t->Net::Telnet::open(Host => $self->{'insultHost'}, Port => $self->{'insultPort'});
$line = "$1: ".$t->Net::Telnet::getline(Timeout => 4);
};
}
if ($line) {
$self->say($event, $line);
} else {
$self->say($event, "$event->{'from'}: What have they ever done to you! Leave 'em alone!");
$self->debug("yikes, $self->{'insultHost'}:$self->{'insultPort'} is down!");
}
} elsif ($message =~ /^\s*(?:please\s+)?(?:can\s+i\s+have\s+an\s+|(?:(?:can|could)\s+you\s+)?give\s+me\s+an\s+)?excuse(?:[?,.!1\s]+please)?\s*[!?,.1]*\s*$/osi) {
my $line;
eval {
my $t = new Net::Telnet (Timeout => 3);
$t->Net::Telnet::open(Host => $self->{'excuseHost'}, Port => $self->{'excusePort'});
# print "=== The BOFH-style Excuse Server --- Feel The Power!\n";
$t->Net::Telnet::getline(Timeout => 4);
# print "=== By Jeff Ballard <ballard\@cs.wisc.edu>\n";
$t->Net::Telnet::getline(Timeout => 4);
# print "=== See http://www.cs.wisc.edu/~ballard/bofh/ for more info.\n";
$t->Net::Telnet::getline(Timeout => 4);
# print "Your excuse is: $excuses[$j]";
$line = $t->Net::Telnet::getline(Timeout => 4);
};
if ($line) {
# $line =~ s/^.*?Your excuse is: //gosi;
# $self->say($event, "$event->{'from'}: '$line'");
$self->say($event, "$line");
} else {
$self->say($event, "$event->{'from'}: Don't ask *me* for an excuse! Sheesh!");
$self->debug("yikes, $self->{'excuseHost'}:$self->{'excusePort'} is down!");
}
} else {
return $self->SUPER::Told(@_);
}
return 0; # we've dealt with it, no need to do anything else.
}

View File

@@ -1,290 +0,0 @@
# -*- Mode: perl; tab-width: 4; indent-tabs-mode: nil; -*-
################################
# Seen Module #
################################
package BotModules::Seen;
use vars qw(@ISA);
@ISA = qw(BotModules);
use AnyDBM_File;
use Fcntl;
1;
# SpottedNickChange would be a nice one to do if you
# can solve the problem of working out which channel
# to say stuff in...
# database for seen data
our $seen = {'times' => {}, 'states' => {}};
# the times that the relevant nicks were last seen active
tie(%{$seen->{'times'}}, 'AnyDBM_File', 'seen-times', O_RDWR|O_CREAT, 0666);
# what the relevant nicks were last seen doing
tie(%{$seen->{'states'}}, 'AnyDBM_File', 'seen-states', O_RDWR|O_CREAT, 0666);
sub Help {
my $self = shift;
my ($event) = @_;
my %commands = {
'seen' => 'Says how long it\'s been since the last time someone was seen. Syntax: seen victim',
};
if ($self->isAdmin($event)) {
$commands{'mute'} = 'Stop responding to !seen <name> in a channel unless told directly. Syntax: mute seen in <channel>';
$commands{'unmute'} = 'Start responding to !seen <name> in a channel. Syntax: unmute seen in <channel>';
}
return \%commands;
}
# RegisterConfig - Called when initialised, should call registerVariables
sub RegisterConfig {
my $self = shift;
$self->SUPER::RegisterConfig(@_);
$self->registerVariables(
# [ name, save?, settable? ]
['overrides', 1, 1, {'therapist' => 'Look, dude, I\'m feeling fine, mm\'k?'}], # canned responses
['maxLines', 1, 1, 5],
['directOnlyChannels', 1, 1, []], #list of channels where we're only observing and not responding to !seen unless told.
);
}
sub Told {
my $self = shift;
my ($event, $message) = @_;
my $now = $event->{'time'};
$self->{'_lastSpoken'}->{$event->{'user'}} = $now;
if ($event->{'channel'} ne '') {
my $channel = $event->{'channel'};
$seen->{'times'}->{lc $event->{'from'}} = $now;
$seen->{'states'}->{lc $event->{'from'}} = "saying '$message' to me in $channel.";
}
if ($self->isAdmin($event) and $message =~ /^\s*(un)?mute\s+seen\s+in\s+(\S+)\s*$/osi){
my $mute = !defined($1);
my $channel = lc $2;
$channel =~ s/^\#?/\#/; # Add # character if needed.
$self->MuteOrUnmuteChannel($event, $mute, $channel);
}elsif ($message =~ /^\s*!?seen\s+(\S+?)[\s?.!]*$/osi) {
$self->DoSeen($event, $1);
} else {
return $self->SUPER::Told(@_);
}
return 0; # we've dealt with it, no need to do anything else.
}
sub Heard {
my $self = shift;
my ($event, $message) = @_;
if ($event->{'channel'} ne '') {
my $channel = $event->{'channel'};
$seen->{'times'}->{lc $event->{'from'}} = $event->{'time'};
$seen->{'states'}->{lc $event->{'from'}} = "saying '$message' in $channel.";
}
if (!(grep {$event->{'channel'} eq $_} @{$self->{'directOnlyChannels'}}) and $message =~ /^\s*!seen\s+(\S+)\s*$/osi) {
$self->DoSeen($event, $1);
} else {
return $self->SUPER::Heard(@_);
}
return 0; # we've dealt with it, no need to do anything else.
}
sub Felt {
my $self = shift;
my ($event, $message) = @_;
if ($event->{'channel'} ne '') {
my $nick = $event->{'from'};
my $channel = $event->{'channel'};
$seen->{'times'}->{lc $event->{'from'}} = $event->{'time'};
$seen->{'states'}->{lc $event->{'from'}} = "saying '* $nick $message' in $channel.";
} else {
return $self->SUPER::Felt(@_);
}
return 0; # we've dealt with it, no need to do anything else.
}
sub Saw {
my $self = shift;
my ($event, $message) = @_;
if ($event->{'channel'} ne '') {
my $nick = $event->{'from'};
my $channel = $event->{'channel'};
$seen->{'times'}->{lc $event->{'from'}} = $event->{'time'};
$seen->{'states'}->{lc $event->{'from'}} = "saying '* $nick $message' in $channel.";
} else {
return $self->SUPER::Felt(@_);
}
return 0; # we've dealt with it, no need to do anything else.
}
# SpottedNickChange - Called when someone changes nick
sub SpottedNickChange {
my $self = shift;
my ($event, $from, $to) = @_;
$seen->{'times'}->{lc $event->{'from'}} = $event->{'time'};
$seen->{'states'}->{lc $event->{'from'}} = "changing nick to $to.";
return $self->SUPER::SpottedNickChange(@_);
}
sub DoSeen {
my $self = shift;
my ($event, $who) = @_;
my $pattern;
if (lc $who eq lc $event->{'from'}) {
$self->say($event, 'You\'re right here, duh!');
} elsif (lc $who eq lc $event->{'nick'}) {
$self->say($event, 'I\'m right here, duh!');
} elsif (defined($self->{'overrides'}->{$who})) {
$self->say($event, $self->{'overrides'}->{$who});
} else {
my $regexp;
my @nicksToList = ();
if ($who =~ m!^/(\S+)/$!) { # shouldn't allow mix and match or blank RE or spaces.
$regexp = $1;
my $re = $self->sanitizeRegexp($regexp); # security + safety first!
$re = qr/$re/i; #precompile for performance
if ('' =~ $re){ # will match everything, throw error.
$self->say($event, 'That pattern matches everything, please be more specific.');
return;
}
@nicksToList = grep {$_ =~ $re} (keys %{$seen->{'times'}});
$pattern = 1;
} else {
if ($who =~ /\*/){ # no point going through the motions if there's no wildcard.
$regexp = quotemeta(lc $who);
$regexp =~ s/\\\*/\\S*/g; # replace the escaped * from quotemeta with a \S* (XXX wanted: the ? wildcard)
my $re = qr/^$regexp$/;
if ('' =~ $re){ # will match everything, throw error.
$self->say($event, 'That pattern matches everything, please be more specific.');
return;
}
@nicksToList = grep {$_ =~ $re} (keys %{$seen->{'times'}});
} else {
@nicksToList = (lc $who) if defined($seen->{'times'}{lc $who}); # short circuit for the majority of uses
}
$pattern = 0;
}
if (@nicksToList > $self->{'maxLines'}) { # if it's more than the set threshold, don't flood :)
$self->say($event,"There are more than $self->{'maxLines'} nicks matching that wildcard, please be more specific.");
} elsif (@nicksToList > 0) {
foreach my $nick (@nicksToList) {
my $seconds = $seen->{'times'}->{$nick};
$seconds = $event->{'time'} - $seconds;
my $time = '';
if ($seconds > 90) {
my $minutes = int $seconds / 60;
$seconds %= 60;
if ($minutes > 90) {
my $hours = int $minutes / 60;
$minutes %= 60;
if ($hours > 36) {
my $days = int $hours / 24;
$hours %= 24;
if ($days > 10) {
my $weeks = int $days / 7;
$days %= 7;
if ($weeks > 10) {
# good god, nice connection
}
if ($weeks != 0) {
if ($time ne '') {
$time .= ', ';
}
if ($weeks == 1) {
$time .= "$weeks week";
} else {
$time .= "$weeks weeks";
}
}
}
if ($days != 0) {
if ($time ne '') {
$time .= ', ';
}
if ($days == 1) {
$time .= "$days day";
} else {
$time .= "$days days";
}
}
}
if ($hours != 0) {
if ($time ne '') {
$time .= ', ';
}
if ($hours == 1) {
$time .= "$hours hour";
} else {
$time .= "$hours hours";
}
}
}
if ($minutes != 0) {
if ($time ne '') {
$time .= ', ';
}
if ($minutes == 1) {
$time .= "$minutes minute";
} else {
$time .= "$minutes minutes";
}
}
}
if ($seconds == 0) {
if ($time eq '') {
$time .= 'right about now';
} else {
$time .= ' ago';
}
} else {
if ($time ne '') {
$time .= ' and ';
}
if ($seconds == 1) {
$time .= 'a second ago';
} elsif ($seconds == 2) {
$time .= 'a couple of seconds ago';
} else {
$time .= "$seconds seconds ago";
}
}
my $what = $seen->{'states'}->{$nick};
$self->say($event, "$nick was last seen $time, $what");
}
} else {
my $n = '';
if ($who =~ /^[aeiou]/o) {
$n = 'n';
}
if ($pattern == 1) {
$self->say($event, "I've never seen anyone matching the pattern '$who', sorry.");
} else {
$self->say($event, "I've never seen a$n '$who', sorry.");
}
}
}
}
sub Unload {
untie(%{$seen->{'times'}});
untie(%{$seen->{'states'}});
}
sub MuteOrUnmuteChannel {
my $self = shift;
my ($event, $mute, $channel) = @_;
if ($mute){
if (grep {$_ eq $channel} @{$self->{'directOnlyChannels'}}){
$self->say($event,"I'm already ignoring !seen <name> in $channel.");
} else{
push @{$self->{'directOnlyChannels'}}, $channel;
$self->say($event, "I won't respond to !seen <name> in $channel anymore unless told directly.");
$self->saveConfig();
}
} else {
if (grep {$_ eq $channel} @{$self->{'directOnlyChannels'}}){
@{$self->{'directOnlyChannels'}} = map {$_ ne $channel} @{$self->{'directOnlyChannels'}};
$self->say($event,"I'll start responding to !seen <name> in $channel now.");
$self->saveConfig();
} else{
$self->say($event, "I'm already responding to !seen <name> in $channel.");
}
}
}

View File

@@ -1,88 +0,0 @@
################################
# Services Login Module #
################################
package BotModules::ServicesLogin;
use vars qw(@ISA);
@ISA = qw(BotModules);
1;
# This module allows your mozbot to login to Network Services such as
# Nickserv, K9, Q on Quakenet, or X on Undernet.
#
# It works in two ways:
# * it logs in when the bot connects to IRC
# * it reauthenticates at regular intervals, to assure that mozbot is
# logged in at all times
#
# This module was originally written by Mohamed Elzakzoki
# <mhtawfiq@earthlink.net>.
sub RegisterConfig {
my $self = shift;
$self->SUPER::RegisterConfig(@_);
$self->registerVariables(
# [ name, save?, settable? ]
['loginCommand', 1, 1, undef],
['servicesNick', 1, 1, undef],
['delay', 1, 1, 900], # defaults to every 15 minutes
);
}
sub Schedule {
my $self = shift;
my ($event) = @_;
unless ($self->login($event)) {
$self->tellAdmin($event, 'To make me log in to a particular service, use the \'setupServicesLogin\' command, as in \'setupServicesLogin x@services.undernet.org login foobot p455w0rd\'. Type \'help setupServicesLogin\' for more information.');
}
$self->schedule($event, \$self->{'delay'}, -1, 'login');
$self->SUPER::Schedule($event);
}
sub Help {
my $self = shift;
my ($event) = @_;
return {
'' => 'The ServicesLogin module logs mozbot into services such as X on Undernet, Q on Quakenet, or NickServ or K9 on other networks. To setup the ServicesLogin command, use the setupServicesLogin command. See \'help setupServicesLogin\'.',
'setupServicesLogin' => 'The syntax of this command is \'setupServicesLogin <servicesNick> <loginCommand>\'. If the services nick is \'q@cserve.quakenet.org\', and the login command is \'auth mozbot mypass\', then you would type \'setupServicesLogin q@cserve.quakenet.org auth mozbot mypass\'. This will then cause mozbot to do: /msg q@cserve.quakenet.org auth mozbot mypass',
} if $self->isAdmin($event);
return {};
}
sub Scheduled {
my $self = shift;
my ($event, @data) = @_;
if ($data[0] eq 'login') {
$self->login($event);
} else {
$self->SUPER::Scheduled($event, @data);
}
}
sub Told {
my $self = shift;
my ($event, $message) = @_;
if ($message =~ /^\s*setup\s*services\s*login\s+(\S+)\s+(.+?)\s*$/osi) {
$self->{'servicesNick'} = $1;
$self->{'loginCommand'} = $2;
$self->saveConfig();
$self->say($event, "Ok, I'll contact $self->{'servicesNick'} regularly from now on.");
$self->login($event);
} else {
return $self->SUPER::Told(@_);
}
return 0; # we've dealt with it, no need to do anything else.
}
sub login {
my $self = shift;
my ($event) = @_;
if (defined $self->{'servicesNick'} and
defined $self->{'loginCommand'}) {
local $event->{'target'} = $self->{'servicesNick'};
$self->privsay($event, $self->{'loginCommand'});
return 1;
}
return 0;
}

View File

@@ -1,140 +0,0 @@
################################
# Sheriff Module #
################################
package BotModules::Sheriff;
use vars qw(@ISA);
@ISA = qw(BotModules);
1;
# RegisterConfig - Called when initialised, should call registerVariables
sub RegisterConfig {
my $self = shift;
$self->SUPER::RegisterConfig(@_);
$self->registerVariables(
# [ name, save?, settable? ]
['tree', 1, 1, 'SeaMonkey'],
['baseURI', 1, 1, 'http://tinderbox.mozilla.org/'],
['_sheriff', 1, 0, undef], # the undef actually means "don't touch", of course
['updateDelay', 1, 1, 360],
# XXX implement per-channel muting of the update notification
);
}
# Schedule - called when bot connects to a server, to install any schedulers
# use $self->schedule($event, $delay, $times, $data)
# where $times is 1 for a single event, -1 for recurring events,
# and a +ve number for an event that occurs that many times.
sub Schedule {
my $self = shift;
my ($event) = @_;
$self->schedule($event, \$self->{'updateDelay'}, -1, 'sheriff');
$self->SUPER::Schedule($event);
}
sub Help {
my $self = shift;
my ($event) = @_;
return {
'' => 'The Sheriff module keeps track of the current sheriff.',
'sheriff' => 'Display the current sheriff. Syntax: sheriff [tree]',
};
}
sub Told {
my $self = shift;
my ($event, $message) = @_;
if ($message =~ /^\s*(?:who's\s+|whose\s+|whos\s+|who\s+is\s+the\s+|who\s+is\s+|who\s+)?sheriff(?:\s+(?:of\s+)?(.*?))?(?:[\s,]+today)?[.?!1]*\s*$/osi) {
$self->GetSheriff($event, $1 || $self->{'tree'}, 'requested');
} else {
return $self->SUPER::Told(@_);
}
return 0; # dealt with it...
}
sub GetSheriff {
my $self = shift;
my ($event, $tree, $requested) = @_;
my $url = "$self->{'baseURI'}$tree/sheriff.pl";
$self->getURI($event, $url, $tree, $requested);
}
sub GotURI {
my $self = shift;
my ($event, $uri, $output, $tree, $requested) = @_;
# someone please pretty up the logic here... XXX
if ($output) {
# magicness
{ no warnings; # this can go _very_ wrong easily
# sheriff.pl is created using the following lines:
# $m =~ s/\'/\\\'/g;
# print SHERIFF "\$current_sheriff = '$m';\n1;";
$output =~ s/^\$current_sheriff = '//gosi; # strip front
$output =~ s/';\n1;$//gosi; # strip back
$output =~ s/\\\'/\'/gosi; # dequote quotes
# heuristics
$output =~ s/<!--.*?-->//gos;
$output =~ s/\n|\r|<a\s+href="|<\/a>//gosi;
$output =~ s/">/, /gosi;
$output =~ s/<br>|<\/?p><\/?div>/ /gosi;
$output =~ s/<\/?(?:b|strong)>/*/gosi;
$output =~ s/<\/?(?:u|em)>/_/gosi;
$output =~ s/<\/?(?:q)>/"/gosi;
$output =~ s/<\/?(?:i|dfn|cite)>/\//gosi;
}
if (defined($output)) {
if ($tree eq $self->{'tree'}) {
if ((defined($self->{'_sheriff'})) and ($self->{'_sheriff'} ne '')) { # not first time
if ($output ne $self->{'_sheriff'}) { # changed.
$self->announce($event, "Sheriff change: $output");
if (($requested) and (not ($event->{'channel'}))) {
$self->directSay($event, "$output");
}
} elsif ($requested) {
$self->say($event, "$event->{'from'}: $output");
}
} else { # first time
$self->say($event, "$event->{'from'}: $output") if ($requested);
}
$self->{'_sheriff'} = $output; # update internal cache
} else { # not default tree
if ($requested) {
$self->say($event, "$event->{'from'}: $output");
} # else EH!?
}
} else {
# something went very wrong
$self->say($event, "$event->{'from'}: I have no idea -- the '$tree' tree probably doesn't have a sheriff.") if ($requested);
if ($tree eq $self->{'tree'}) {
if (defined($self->{'_sheriff'})) {
# only do it once
$self->tellAdmin($event, "Oh dear lord what happened to the '$tree' sheriff line on the tinderbox page!!");
$self->{'_sheriff'} = undef;
}
}
}
} else {
if ($tree eq $self->{'tree'}) {
$self->say($event, "$event->{'from'}: Call an admin, I couldn't find the Sheriff page. Sorry!") if ($requested);
if (defined($self->{'_sheriff'})) {
# only do it once
$self->tellAdmin($event, "Looks like either I am badly configured or tinderbox is down - '$tree' came up blank when I went looking for the Sheriff.");
$self->{'_sheriff'} = undef;
}
} else {
if ($requested) {
$self->say($event, "$event->{'from'}: Are you sure there is a tree called '$tree'? I couldn't find one...");
} # else EH!?
}
}
}
sub Scheduled {
my $self = shift;
my ($event, @data) = @_;
if ($data[0] eq 'sheriff') {
$self->GetSheriff($event, $self->{'tree'}, 0);
} else {
$self->SUPER::Scheduled($event, @data);
}
}

View File

@@ -1,119 +0,0 @@
# -*- Mode: perl; tab-width: 4; indent-tabs-mode: nil; -*-
################################
# Spell Checker Module #
################################
package BotModules::Spell;
use vars qw(@ISA);
@ISA = qw(BotModules);
1;
# XXX Ideally we should move to using www.dict.org
sub Help {
my $self = shift;
my ($event) = @_;
return {
'' => 'This module checks for spelling errors.',
'sp' => 'If you aren\'t sure of the spelling of a word, append \'(sp)\' to the word, and it will be checked for you. '.
'For example: \'My speling (sp?) is awful!\''
};
}
sub Told {
my $self = shift;
my ($event, $message) = @_;
if ($self->checkSpelling($event, $message)) {
# we checked the spelling, abort
return 0;
}
return $self->SUPER::Heard(@_);
}
sub Heard {
my $self = shift;
my ($event, $text) = @_;
$self->checkSpelling($event, $text);
return $self->SUPER::Heard(@_);
}
sub checkSpelling {
my $self = shift;
my ($event, $text) = @_;
while ($text =~ s/^.*? # take everything up to the first word to check
\b # look for a word break
(\w+) # take the word to spell
\s* # look for whitespace following it
\(sp\??\) # followed by (sp) or (sp?)
//isox) { # and remove everything up to here so we can do another check in a minute
my $word = $1;
# XXX escape $word
$self->getURI($event, "http://www.merriam-webster.com/dictionary/$word", 'word', $1); # XXX should be configurable!
return 1;
}
return 0;
}
sub GotURI {
my $self = shift;
my ($event, $query, $result, $command, $word) = @_;
if ($command ne 'word') {
return $self->SUPER::GorURI(@_);
} else {
my $reply;
# Determine if page is error or not
if (!length($result)) {
$self->debug("Waah, failed utterly to get a response for '$word' from the dictionary server.");
$reply = "The dictionary service is not accessible right now, sorry.";
} elsif ($result =~ / # Match
The\ word\ you've\ entered\ # literal string
isn't\ in\ the\ dictionary\. # (not very smart),
.*? # anything (non-greedy),
<PRE> # PRE tag,
(.*?) # our suggestions,
<\/PRE> # PRE tag
/osx
|| $result =~ / # Match
The\ word\ you've\ entered\ # literal string
isn't\ in\ the\ dictionary\. # (not very smart),
.*? # anything (non-greedy),
<ol.*?\"> # OL tag,
(.*?) # our suggestions,
<\/ol> # OL tag
/osx
# XXX this is hardcoded to m-w.com!
) {
# Strip line numbering and anchor tags
my $suggestions = $1;
$suggestions =~ s/\s+[\d]+\.\s+//go;
$suggestions =~ s/<a href.*?>(.*?)<\/a>/$1 /go;
$suggestions =~ s/<li>(.*?)<\/li>/$1 /go;
# get them in list format
my @suggestions = split(' ', $suggestions);
# Comma delimit suggestions
local $" = ', ';
if (@suggestions > 7) {
# lots of suggestions!
# 7 is not arbitrary, it's supposed to be the number
# of items people can remember at once.
@suggestions = @suggestions[0..6];
$reply = "Suggestions for '$word': @suggestions[0..6]...";
} elsif (@suggestions) {
# just a few suggestions
$reply = "Suggestions for '$word': @suggestions";
} else {
# eh? Weird. Some problem on the server probably.
$self->debug("Didn't get any suggestions for '$word'!");
$reply = "I have no idea what '$word' is supposed to be, sorry.";
}
} else {
# horrah!
$reply = "'$word' seems to be the correct spelling.";
}
$self->say($event, $reply);
return 0;
}
}

View File

@@ -1,54 +0,0 @@
# -*- Mode: perl; tab-width: 4; indent-tabs-mode: nil; -*-
################################
# Stocks Module #
################################
package BotModules::Stocks;
use vars qw(@ISA);
@ISA = qw(BotModules);
1;
# XXX Per-channel configurable notification of stock changes
# XXX Non-US markets
sub Help {
my $self = shift;
my ($event) = @_;
return {
'' => 'This module gets stock quotes. Ask me a ticker symbol, I will retrieve the quote.',
'stock' => 'Call this command with a ticker symbol to get the current stock price and change. Syntax: stock FBAR',
};
}
sub Told {
my $self = shift;
my ($event, $message) = @_;
if ($message =~ /^\s*stocks?\s+(.+?)\s*$/osi) {
$self->getURI($event, "http://download.finance.yahoo.com/d/quotes.csv?f=sl1d1t1c1ohgv&e=.csv&s=$1", $1);
} else {
return $self->SUPER::Told(@_);
}
return 0; # we've dealt with it, no need to do anything else.
}
sub GotURI {
my $self = shift;
my ($event, $uri, $output, $stock) = @_;
$self->debug($output);
my $message = "$event->{'from'}: ";
# The data currently listed in this format are: ticker symbol, last price, date, time, change, open price, daily high, daily low, and volume.
# -- http://help.yahoo.com/help/us/fin/quote/quote-05.html
my @stockValues = split(',', $output);
foreach my $part (@stockValues) {
$part =~ s/"//gos; # remove all quotes. Bit of a hack, but... XXX
}
if ($stockValues[4] > 0) {
$stockValues[4] = 'up ' . (0+$stockValues[4]);
} elsif ($stockValues[4] < 0) {
$stockValues[4] = 'down ' . (0-$stockValues[4]);
} else {
$stockValues[4] = 'no change';
}
$message .= "Stock quote for $stockValues[0]: $stockValues[1], $stockValues[4] (low: $stockValues[7], high: $stockValues[6])";
$self->say($event, $message);
}

View File

@@ -1,508 +0,0 @@
# -*- Mode: perl; tab-width: 4; indent-tabs-mode: nil; -*-
################################
# Tinderbox Module #
################################
package BotModules::Tinderbox;
use vars qw(@ISA);
@ISA = qw(BotModules);
1;
# RegisterConfig - Called when initialised, should call registerVariables
sub RegisterConfig {
my $self = shift;
$self->SUPER::RegisterConfig(@_);
$self->registerVariables(
# [ name, save?, settable? ]
['trees', 1, 1, ['SeaMonkey', 'SeaMonkey-Ports', 'MozillaTest', 'Grendel']],
['treesAnnounced', 1, 1, ['SeaMonkey', 'SeaMonkey-Ports']],
['treesDefault', 1, 1, ['SeaMonkey']],
['treeStates', 0, 0, {}], # ->tree->(current, previous, lastupdate)
['lasttreesStates', 0, 0, []], # copy of trees in last test
['tinderboxStates', 0, 0, {}], # ->tree->build->(current, previous, lastupdate)
['updateDelay', 1, 1, 120],
['useNotice', 1, 1, 1], # set to 1 to use notice and 0 to use a normal message
['_lastupdate', 0, 0, 0],
['preferredLineLength', 1, 1, 100],
['mutes', 1, 1, {}], # tree -> "channel channel channel"
['states', 1, 1, {'success' => 'Success', 'testfailed' => 'Test Failed', 'busted' => 'Burning', }],
['maxInChannel', 1, 1, 5], # maximum number of lines to report in a channel
['tinderboxURI', 1, 1, "http://tinderbox.mozilla.org/"], # base URL for Tinderbox
['isTinderbox2', 1, 1, 0], # whether this is tinderbox2 or not
);
}
# Schedule - called when bot connects to a server, to install any schedulers
# use $self->schedule($event, $delay, $times, $data)
# where $times is 1 for a single event, -1 for recurring events,
# and a +ve number for an event that occurs that many times.
sub Schedule {
my $self = shift;
my ($event) = @_;
$self->schedule($event, \$self->{'updateDelay'}, -1, 'tinderbox');
$self->SUPER::Schedule($event);
}
sub Help {
my $self = shift;
my ($event) = @_;
my %commands = (
'' => 'The Tinderbox module monitors who the state of the tinderboxen.',
'qt' => 'Quick trees, same as \'trees terse\'. You can give it a <tree> argument if you like, for example \'qt seamonkey\'.',
'builds' => 'Gives the status of all the builds in all the trees that match a particular pattern. Syntax: \'builds <build>\'. For example: \'builds Mac\'.',
'trees' => 'Reports on the current state of the tinderboxen. Syntax: \'trees <options> <tree>\' where <options> is any number of: '.
'all (show all trees and all builds), main (show only main trees), burning (show only burning builds), '.
'long, medium, short, terse (how much detail to include), and <tree> is the name of the tree to show (or a regexp matching it).',
);
if ($self->isAdmin($event)) {
$commands{'mute'} = 'Disable reporting of a tree in a channel. (Only does something if the given tree exists.) Syntax: mute tinderbox <tree> in <channel>';
$commands{'unmute'} = 'Enable reporting of a tree in a channel. By default, trees are reported in all channels that the module is active in. Syntax: unmute tinderbox <tree> in <channel>';
}
return \%commands;
}
sub Told {
my $self = shift;
my ($event, $message) = @_;
if ($message =~ /^\s*trees?(?:\s+(.*?))?\s*(?:[, ]\s*please)?\?*\s*$/osi) {
# initial setup
my $trees = -1; # 0=default; 1=all; 'x'=pattern match
my $builds = -1; # 0=all; 1=horked and test failed; 2=horked only
my $verbosity = -1; # 1=terse; 2; 3; 4=verbose
# parse parameters
if (defined($1)) {
foreach (split(/\s+/, $1)) {
if (/^all$/osi) { $trees = '1' if $trees < 0; $builds = 0 if $builds < 0; }
elsif (/^main$/osi) { $trees = '0'; }
elsif (/^burning$/osi) { $builds = 2; }
elsif (/^long$/osi) { $verbosity = 4; }
elsif (/^medium$/osi) { $verbosity = 3; }
elsif (/^short$/osi) { $verbosity = 2; }
elsif (/^terse$/osi) { $verbosity = 1; }
else { $trees = $_; }
}
}
# defaults
$trees = '0' if $trees < 0;
$builds = 1 if $builds < 0;
$verbosity = 2 if $verbosity < 0;
# go
$self->GetTrees($event, 1, $trees, $builds, $verbosity);
} elsif ($message =~ /^\s*builds?\s+(.*?)\s*\?*\s*$/osi) {
$self->GetTrees($event, 2, $1);
} elsif ($message =~ /^\s*qt(?:\s+(.+?))?\s*$/osi) {
$self->GetTrees($event, 1, defined($1) ? $1 : 0, 1, 1);
} elsif ($self->isAdmin($event)) {
if ($message =~ /^\s*mute tinderbox\s+(\S+?)\s+in\s+(\S+?)\s*$/osi) {
my $tree = $1 eq 'Tinderbox' ? '' : $1;
my $treeName = $tree eq '' ? 'all trees' : "trees named $tree";
if (($tree eq '') or (grep $_ eq $tree, @{$self->{'trees'}})) {
$self->{'mutes'}->{$tree} .= " $2";
$self->saveConfig();
$self->say($event, "$event->{'from'}: Tinderbox notifications for $treeName muted in channel $2.");
} else {
$self->say($event, "$event->{'from'}: There is no tree called $tree is there?.");
}
} elsif ($message =~ /^\s*unmute tinderbox\s+(\S+?)\s+in\s+(\S+?)\s*$/osi) {
my $tree = $1 eq 'Tinderbox' ? '' : $1;
my $treeName = $tree eq '' ? 'all trees' : "trees named $tree";
if (($tree eq '') or (grep $_ eq $tree, @{$self->{'trees'}})) {
my %mutedChannels = map { lc($_) => 1 } split(/ /o, $self->{'mutes'}->{$1});
delete($mutedChannels{lc($2)}); # get rid of any mentions of that channel
$self->{'mutes'}->{$1} = join(' ', keys(%mutedChannels));
$self->saveConfig();
$self->say($event, "$event->{'from'}: Tinderbox notifications for trees named $1 resumed in channel $2.");
} else {
$self->say($event, "$event->{'from'}: There is no tree called $tree is there?.");
}
} else {
return $self->SUPER::Told(@_);
}
} else {
return $self->SUPER::Told(@_);
}
return 0; # dealt with it...
}
sub GetTrees {
my $self = shift;
my ($event, $requested, @mode) = @_;
my @trees = @{$self->{'trees'}};
if ($self->{'isTinderbox2'}) {
foreach (@trees) {
my $uri = $self->{'tinderboxURI'} . $_ . "/quickparse.html";
$self->getURI($event, $uri, $requested, @mode);
}
} else {
local $" = ','; # XXX %-escape this
my $uri = $self->{'tinderboxURI'} . "showbuilds.cgi?quickparse=1&tree=@trees";
$self->getURI($event, $uri, $requested, @mode);
}
}
sub GotURI {
my $self = shift;
my ($event, $uri, $output, $requested, @mode) = @_;
if ($output) {
my $now = $event->{'time'};
$self->{'_lastupdate'} = $now;
my @lines = split(/\n/os, $output);
# loop through quickparse output
foreach my $line (@lines) {
my ($type, $tree, $build, $state) = split(/\|/os, $line);
if ($type eq 'State') {
$self->{'treeStates'}->{$tree}->{'lastupdate'} = $now;
if (defined($self->{'treeStates'}->{$tree}->{'current'})) {
$self->{'treeStates'}->{$tree}->{'previous'} = $self->{'treeStates'}->{$tree}->{'current'};
}
$self->{'treeStates'}->{$tree}->{'current'} = $state;
$self->{'states'}->{$state} = $state unless defined($self->{'states'}->{$state});
} elsif ($type eq 'Build') {
$self->{'tinderboxStates'}->{$tree}->{$build}->{'lastupdate'} = $now;
if (defined($self->{'tinderboxStates'}->{$tree}->{$build}->{'current'})) {
$self->{'tinderboxStates'}->{$tree}->{$build}->{'previous'} = $self->{'tinderboxStates'}->{$tree}->{$build}->{'current'};
}
$self->{'tinderboxStates'}->{$tree}->{$build}->{'current'} = $state;
$self->{'states'}->{$state} = $state unless defined($self->{'states'}->{$state});
} # else unsupported type XXX
}
#If a Tinderbox tree is configured without Bonsai, it lacks a state line and doesn't
# appear properly in the trees output (even though machine state changes work.)
# Work around this by setting a default state of Unknown to trees w/o a state line.
my $state = "unknown";
foreach my $tree (keys(%{$self->{'tinderboxStates'}})) {
if (!defined($self->{'treeStates'}->{$tree})) {
$self->{'treeStates'}->{$tree}->{'current'} = $state;
$self->{'treeStates'}->{$tree}->{'lastupdate'} = $now;
if (defined($self->{'treeStates'}->{$tree}->{'current'})) {
$self->{'treeStates'}->{$tree}->{'previous'} = $self->{'treeStates'}->{$tree}->{'current'};
}
$self->{'states'}->{$state} = $state unless defined($self->{'states'}->{$state});
}
#Update timestamps on trees we're 'managing' state on.
if (($self->{'treeStates'}->{$tree}->{'current'} eq $state) and
($self->{'treeStates'}->{$tree}->{'lastupdate'} < $now)) {
$self->{'treeStates'}->{$tree}->{'lastupdate'} = $now;
}
}
$self->CheckForUpdates($event, $requested);
if ($requested == 1) {
$self->ReportState($event, @mode);
} elsif ($requested == 2) {
$self->ReportBuild($event, @mode);
}
# update list of active trees
@{$self->{'lasttreesState'}} = @{$self->{'trees'}};
} else {
if ($requested) {
$self->say($event, "$event->{'from'}: I can't access tinderbox right now, sorry.");
}
$self->debug('failed to get tinderbox data');
}
}
sub Scheduled {
my $self = shift;
my ($event, @data) = @_;
if ($data[0] eq 'tinderbox') {
$self->GetTrees($event, 0);
} else {
$self->SUPER::Scheduled($event, @data);
}
}
sub CheckForUpdates {
my $self = shift;
my ($event, $avoidTarget) = @_;
my $a; # disclaimer: I was asleep when I wrote the next line. I've no longer any idea what it does.
my @trees = map { $a = $_; grep { $_ eq $a } @{$self->{'lasttreesState'}}; } @{$self->{'treesAnnounced'}};
# After staring at it for a few minutes, I think what it does is get a list of the trees that should
# be announced, AND that have already been found to exist. But I'm not 100% sure.
foreach my $tree (@trees) {
my @newTrees;
my @newBuilds;
my @lostBuilds;
my @lostTrees;
my @changes;
# check trees
if (defined($self->{'treeStates'}->{$tree})) {
if ($self->{'treeStates'}->{$tree}->{'lastupdate'} == $self->{'_lastupdate'}) {
if (defined($self->{'treeStates'}->{$tree}->{'previous'})) {
if ($self->{'treeStates'}->{$tree}->{'previous'} ne $self->{'treeStates'}->{$tree}->{'current'}) {
push(@changes, "$tree has changed state from $self->{'states'}->{$self->{'treeStates'}->{$tree}->{'previous'}} to $self->{'states'}->{$self->{'treeStates'}->{$tree}->{'current'}}.");
}
} else {
push(@newTrees, "New tree added to tinderbox: $tree (state: $self->{'states'}->{$self->{'treeStates'}->{$tree}->{'current'}}).");
}
} else {
# tree has dissappeared!
delete($self->{'treeStates'}->{$tree});
push(@lostTrees, "Eek!!! Tree '$tree' has been removed from tinderbox!");
}
} # else tree doesn't exist
# check builds
if (defined($self->{'tinderboxStates'}->{$tree})) {
foreach my $build (keys(%{$self->{'tinderboxStates'}->{$tree}})) {
if ($self->{'tinderboxStates'}->{$tree}->{$build}->{'lastupdate'} == $self->{'_lastupdate'}) {
if (defined($self->{'tinderboxStates'}->{$tree}->{$build}->{'previous'})) {
if ($self->{'tinderboxStates'}->{$tree}->{$build}->{'previous'} ne $self->{'tinderboxStates'}->{$tree}->{$build}->{'current'}) {
push(@changes, "$tree: '$build' has changed state from $self->{'states'}->{$self->{'tinderboxStates'}->{$tree}->{$build}->{'previous'}} to $self->{'states'}->{$self->{'tinderboxStates'}->{$tree}->{$build}->{'current'}}.");
}
} else {
push(@newBuilds, "$tree: Build '$build' added to tinderbox. (Status: $self->{'states'}->{$self->{'tinderboxStates'}->{$tree}->{$build}->{'current'}}).");
}
} else {
# build has dissappeared!
delete($self->{'tinderboxStates'}->{$tree}->{$build});
push(@lostBuilds, "$tree: Build '$build' has dropped from tinderbox.");
}
}
} # else tree doesn't exist
# sort out which channels to talk to
my %mutedChannels = ();
if (defined($self->{'mutes'}->{$tree})) {
%mutedChannels = map { lc($_) => 1 } split(/\s+/os, $self->{'mutes'}->{$tree});
}
if (defined($self->{'mutes'}->{''})) {
%mutedChannels = (%mutedChannels, map { lc($_) => 1 } split(/\s+/os, $self->{'mutes'}->{''}));
}
if (($avoidTarget) and ($event->{'target'} eq $event->{'channel'})) {
$mutedChannels{$event->{'channel'}} = 1;
}
# speak!
my @output = (@newTrees, @lostTrees, @newBuilds, @lostBuilds);
foreach (@{$self->{'channels'}}) {
unless ($mutedChannels{$_}) {
local $event->{'target'} = $_;
foreach (@changes) {
$self->sayOrNotice($event, $_);
}
if (@output < $self->{'maxInChannel'}) {
foreach (@output) {
$self->sayOrNotice($event, $_);
}
} else {
$self->sayOrNotice($event, "Many tree changes just occured. Check tinderbox to see what they were.");
}
}
}
}
}
sub ReportState {
my $self = shift;
my ($event, $trees, $builds, $verbosity) = @_;
# $trees: 0=default; 1=all; 'x'=pattern match
# $builds: 0=all; 1=horked and test failed; 2=horked only
# $verbosity: 1=terse; 2; 3; 4=verbose
# the complete output
my @lines;
# work out which trees we want
my @trees;
if ($trees eq '0') {
@trees = @{$self->{'treesDefault'}};
} elsif ($trees eq '1') {
@trees = @{$self->{'trees'}};
} else {
my $pattern = $self->sanitizeRegexp($trees);
foreach my $tree (keys %{$self->{'treeStates'}}) {
push(@trees, $tree) if $tree =~ /$pattern/si;
}
}
if (@trees) {
foreach my $tree (@trees) {
if ((defined($self->{'treeStates'}->{$tree})) and ($self->{'treeStates'}->{$tree}->{'lastupdate'} == $self->{'_lastupdate'})) {
# setup
my @output;
my ($redShort) = ($self->{'states'}->{'bustedShort'} or split(//osi, $self->{'states'}->{'busted'}));
my $red = 0;
my ($orangeShort) = ($self->{'states'}->{'testfailedShort'} or split(//osi, $self->{'states'}->{'testfailed'}));
my $orange = 0;
my ($greenShort) = ($self->{'states'}->{'successShort'} or split(//osi, $self->{'states'}->{'success'}));
my $green = 0;
# foreach build
if (defined($self->{'tinderboxStates'}->{$tree})) {
foreach my $build (keys(%{$self->{'tinderboxStates'}->{$tree}})) {
if ($self->{'tinderboxStates'}->{$tree}->{$build}->{'lastupdate'} == $self->{'_lastupdate'}) {
my $state = $self->{'tinderboxStates'}->{$tree}->{$build}->{'current'};
# count results
if ($state eq 'success') {
$green++;
} elsif ($state eq 'testfailed') {
$orange++;
} else {
$red++;
}
# make sure we should list this build
if ($state eq 'success') {
next if $builds >= 1;
} elsif ($state eq 'testfailed') {
next if $builds >= 2;
}
if ($verbosity == 1) {
my($minibuild) = split(/\s/osi, $build);
my $ministate = $self->{'states'}->{$state.'Short'};
if (not $ministate) {
($ministate) = split(//osi, $self->{'states'}->{$state});
}
push(@output, "$minibuild: $ministate;");
} elsif (($verbosity == 2) || ($verbosity == 3)) {
my($minibuild) = $verbosity == 2 ? split(/\s/osi, $build) : ($build);
my $ministate = $self->{'states'}->{$state.'Medium'};
if (not $ministate) {
$ministate = $self->{'states'}->{$state};
}
push(@output, "$minibuild ($ministate),");
} else {
push(@output, "[$build: $self->{'states'}->{$state}]")
}
} # else build is dead
} # (foreach build)
} # else tree is dead
# pretty print it
my @newoutput;
if ($verbosity == 1) {
if (@output == 0) {
unless ($red + $green + $orange) {
push(@output, "(none)");
} elsif ($builds <= 1) {
push(@output, "(all green)");
} else {
push(@output, "(none red)");
}
}
my $ministate = $self->{'states'}->{$self->{'treeStates'}->{$tree}->{'current'}.'Short'};
if (not $ministate) {
($ministate) = split(//osi, $self->{'states'}->{$self->{'treeStates'}->{$tree}->{'current'}});
}
@newoutput = $self->wordWrap($self->{'preferredLineLength'},
"$tree <$ministate> $redShort:${red} $orangeShort:${orange} $greenShort:${green} ",
' ', ' ', @output);
$newoutput[0] =~ s/^ //o;
$newoutput[$#newoutput] =~ s/;$//o;
push(@lines, @newoutput);
} elsif (($verbosity == 2) || ($verbosity == 3)) {
unless ($red+$orange+$green) {
push(@lines, "$tree <$self->{'states'}->{$self->{'treeStates'}->{$tree}->{'current'}}>: no tinderboxen for this tree.");
} elsif (($red) or ($orange)) {
if (@output == 0) {
# can only happen if $red is 0 and $builds is 1.
push(@output, "all tinderboxen compile");
}
my @newoutput = $self->wordWrap($self->{'preferredLineLength'},
"$tree <$self->{'states'}->{$self->{'treeStates'}->{$tree}->{'current'}}> $red red, $orange orange, $green green: ",
' ', ' ', @output);
$newoutput[0] =~ s/^ //o;
$newoutput[$#newoutput] =~ s/,$//o;
# if (length(@newoutput[$#newoutput]) < $self->{'preferredLineLength'} - 33) {
# $newoutput[$#newoutput] .= " Summary: $red red, $orange orange, $green green";
# } else {
# push(@newoutput, " Summary: $red red, $orange orange, $green green");
# }
push(@lines, @newoutput);
} else {
push(@lines, "$tree <$self->{'states'}->{$self->{'treeStates'}->{$tree}->{'current'}}>: all $green tinderboxen green!");
}
} else {
if (@output == 0) {
unless ($red + $green + $orange) {
push(@output, "no tinderboxen for this tree.");
} elsif ($builds <= 1) {
push(@output, "all tinderboxen for this tree are green!");
} else {
push(@output, "all tinderboxen for this tree compile successfully.");
}
}
@newoutput = $self->wordWrap($self->{'preferredLineLength'},
"$tree <$self->{'states'}->{$self->{'treeStates'}->{$tree}->{'current'}}> $red red, $orange orange, $green green: ",
' ', ' ', @output);
$newoutput[0] =~ s/^ //o;
push(@lines, @newoutput);
}
} # else tree is dead
} # (foreach tree)
} else { # no tree selected
@lines = ("No tree matches the pattern '$trees', sorry!");
}
$self->Report($event, 'tree status', @lines);
}
sub ReportBuild {
my $self = shift;
my ($event, $pattern) = @_;
# the complete output
my @output;
foreach my $tree (@{$self->{'trees'}}) {
if ((defined($self->{'treeStates'}->{$tree})) and
($self->{'treeStates'}->{$tree}->{'lastupdate'} == $self->{'_lastupdate'}) and
(defined($self->{'tinderboxStates'}->{$tree}))) {
foreach my $build (keys(%{$self->{'tinderboxStates'}->{$tree}})) {
if (($self->{'tinderboxStates'}->{$tree}->{$build}->{'lastupdate'} == $self->{'_lastupdate'}) and
($build =~ /\Q$pattern\E/is)) {
push(@output, "[$build: $self->{'states'}->{$self->{'tinderboxStates'}->{$tree}->{$build}->{'current'}}]")
}
}
}
}
@output = ('There are no matching builds.') unless @output;
@output = $self->prettyPrint($self->{'preferredLineLength'}, undef, "$event->{'from'}: ", ' ', @output);
$self->Report($event, 'tree status', @output);
}
sub Report {
my $self = shift;
my ($event, $what, @output) = @_;
if (scalar(@output) > $self->{'maxInChannel'}) {
foreach (@output) {
$self->directSay($event, $_);
}
$self->channelSay($event, "$event->{'from'}: $what /msg'ed");
} else {
foreach (@output) {
$self->say($event, $_);
}
}
}
sub sayOrNotice {
my $self = shift;
if ($self->{'useNotice'}) {
$self->notice(@_);
} else {
$self->say(@_);
}
}

View File

@@ -1,179 +0,0 @@
################################
# Translate Module #
################################
package BotModules::Translate;
use vars qw(@ISA);
use WWW::Babelfish;
# Ah, the previous line looks so innocent. Yet it hides horrible
# evil. Yes, this module requires the following:
#
# WWW::Babelfish
# libwww (a bundle)
# URI
# MIME-Base64
# HTML::Parser
# HTML-Tagset
# libnet (you probably already have this)
# Digest::MD5
# IO::String
@ISA = qw(BotModules);
1;
# -- #mozilla was here! --
# *** Signoff: techbot_Hixie (~techbot_Hixie@129.59.231.42) has left IRC [Leaving]
# <timeless> oops, i killed your techbot
# RegisterConfig - Called when initialised, should call registerVariables
sub RegisterConfig {
my $self = shift;
$self->SUPER::RegisterConfig(@_);
$self->registerVariables(
# [ name, save?, settable? ]
['supportedservices', 1, 1, {
'Babelfish' => '', #Original WWW::Babelfish Service
'Yahoo' => '', #Available since WWW::Babelfish 0.14
'Google' => '', #Available since WWW::Babelfish 0.12
}],
['languages', 1, 1, {
'en' => 'English',
'fr' => 'French',
'de' => 'German',
'it' => 'Italian',
'es' => 'Spanish',
'ar' => 'Arabic',
'zh' => 'Chinese-simp',
'zt' => 'Chinese-trad',
'zh-CN' => 'Chinese (Simp)', #Google-only
'nl' => 'Dutch',
'el' => 'Greek',
'ja' => 'Japanese',
'pt' => 'Portuguese',
'ru' => 'Russian',
}], # short code => Babelfish Language Name
['defaultLanguage', 1, 1, 'en'],
['defaultservice', 1, 1, 'Babelfish'],
);
}
sub Help {
my $self = shift;
my ($event) = @_;
my @languages = keys(%{$self->{'languages'}});
my @services = keys(%{$self->{'supportedservices'}});
local $";
$" = '|';
return {
'' => 'Translate text between languages using Babelfish or Google.',
'translate' => "Syntax: \'translate [using (@services)] [from (@languages)] [to (@languages)] sentence\'",
'x' => 'Same as translate.',
'languages' => "Returns list of available languages to translate. Syntax: languages [(@services)]"
};
}
sub Told {
my $self = shift;
my ($event, $message) = @_;
if ($message =~ /^\s*(?:translate|x)\s+(.*?)\s*$/osi) {
$self->Translate($event, $1);
} elsif ($message =~ /^\s*languages?(?:\s+(.*?))?\s*(?:[, ]\s*please)?\?*\s*$/osi) {
$self->GetLanguages($event, $1);
} else {
return $self->SUPER::Told(@_);
}
return 0; # dealt with it...
}
sub translate_do {
my $self = shift;
my ($event, $service, $lang1, $lang2, $words) = @_;
my $translate_babelfish = new WWW::Babelfish('service' => $service);
my $result = $translate_babelfish->translate(
'source' => $self->{'languages'}->{$lang1},
'destination' => $self->{'languages'}->{$lang2},
'text' => $words,
);
if ($result !~ /^ *$/os) {
return "$event->{'from'}: $result";
} else {
my $error = $translate_babelfish->error;
if ($error =~ /^ *$/os) {
return "$event->{'from'}: I'm afraid I cannot translate that from $self->{'languages'}->{$lang1} to $self->{'languages'}->{$lang2}.";
} else {
return "$event->{'from'}: $error";
}
}
}
# ChildCompleted - Called when a child process has quit
sub ChildCompleted {
my $self = shift;
my ($event, $type, $output, @data) = @_;
if ($type eq 'babelfish') {
$self->say($event, $output);
} else {
$self->SUPER::ChildCompleted($event, $type, $output, @data);
}
}
sub GetLanguages {
my $self = shift;
my ($event, $rest) = @_;
my @services = keys(%{$self->{'supportedservices'}});
my $service = $self->{'defaultservice'};
$service = $rest if ($rest);
my $languages_babelfish = new WWW::Babelfish('service' => $service);
$self->say($event,"$event->{'from'}: Available Translation Languages (for $service): " . join(", ", $languages_babelfish->languages)."");
}
sub Translate {
my $self = shift;
my ($event, $rest) = @_;
my ($service, $lang1, $lang2, $words) = (
$self->{'defaultservice'},
$self->{'defaultLanguage'},
$self->{'defaultLanguage'},
);
my @services = keys(%{$self->{'supportedservices'}});
my @languages = keys(%{$self->{'languages'}});
local $";
$" = '|';
#check service syntax
if ($rest =~ /^\s*using\s+(@services)\s+(.+)$/os) {
$service = $1 if defined($1);
$rest = $2;
}
# check syntax
if ($rest =~ /^\s*from\s+(@languages)\s+to\s+(@languages)\s+(.+)$/os) {
$lang1 = $1;
$lang2 = $2;
$words = $3;
} elsif ($rest =~ /^\s*to\s+(@languages)\s+from\s+(@languages)\s+(.+)$/os) {
$lang2 = $1;
$lang1 = $2;
$words = $3;
} elsif ($rest =~ /^\s*(from|to)\s+(@languages)\s+(.+)$/os) {
$lang1 = $2 if $1 eq 'from';
$lang2 = $2 if $1 eq 'to';
$words = $3;
} else {
$self->say($event, "$event->{'from'}: Noooo... That\'s not the right syntax at all! Try something like \'translate [using (@services)] [from (@languages)] [to (@languages)] sentence\'");
return;
}
# translate
if ($lang1 eq $lang2) {
$self->say($event, "$event->{'from'}: Erm, well, translating from one language to the same language... doesn't change anything!");
} else {
$self->spawnChild($event, \&translate_do, [$self, $event, $service, $lang1, $lang2, $words], 'babelfish', []);
}
}

View File

@@ -1,68 +0,0 @@
################################
# UUIDGen Module #
################################
# "uuidgen" should be installed on the path somewhere.
# you can get the source of uuidgen from CVS, see:
# http://lxr.mozilla.org/mozilla/source/webtools/mozbot/uuidgen/
package BotModules::UUIDGen;
use vars qw(@ISA);
@ISA = qw(BotModules);
1;
sub Help {
my $self = shift;
my ($event) = @_;
return {
'' => 'This module is an interface to the uuidgen application.',
'uuid' => 'Generates a UUID.',
'cid' => 'Generates a UUID but outputs format suitable for components (CID).',
};
}
sub Told {
my $self = shift;
my ($event, $message) = @_;
if ($message =~ /^\s*uuid(?:[\s,!?]+please)?[\s,!?]*\s*$/osi) {
$self->spawnChild($event, 'uuidgen', [], 'UUID', []);
} elsif ($message =~ /^\s*cid(?:[\s,!?]+please)?[\s,!?]*\s*$/osi) {
$self->spawnChild($event, 'uuidgen', [], 'CID', []);
} else {
return $self->SUPER::Told(@_);
}
return 0; # we've dealt with it, no need to do anything else.
}
# ChildCompleted - Called when a child process has quit
sub ChildCompleted {
my $self = shift;
my ($event, $type, $output, @data) = @_;
if ($type eq 'UUID') {
chop($output);
$output .= " (/msg $nicks[$nick] cid for CID form)";
$self->say($event, $output);
} elsif ($type eq 'CID') {
# remove newline
chop($output);
my @split = split(/-/, $output);
$output = "{0x$split[0], 0x$split[1], 0x$split[2], {";
my @rest = $split[3] =~ m/(..)(..)/;
push(@rest, $split[4] =~ m/(..)(..)(..)(..)(..)(..)/);
foreach (@rest) {
$output .= "0x$_, ";
}
# remove the space and comma
chop($output);
chop($output);
$output .= "}}\n";
$self->say($event, $output);
} else {
return $self->SUPER::ChildCompleted(@_);
}
}

View File

@@ -1,136 +0,0 @@
################################
# WWW Module #
################################
package BotModules::WWW;
use vars qw(@ISA);
# Need HTML::Entities for decode_entities() in wwwtitle
use HTML::Entities;
@ISA = qw(BotModules);
1;
# RegisterConfig - Called when initialised, should call registerVariables
sub RegisterConfig {
my $self = shift;
$self->SUPER::RegisterConfig(@_);
# $self->registerVariables(
# # [ name, save?, settable? ]
# ['x', 1, 1, 0],
# );
}
sub Help {
my $self = shift;
my ($event) = @_;
return {
'' => 'The WWW module provides a web interface.',
'wwwsize' => 'Reports on the size of a webpage. Syntax: \'wwwsize http://...\'',
'wwwlint' => 'Reports on whether the webpage contains any obvious (I mean _really_ obvious) no-nos like <layer> or document.all. Syntax: \'wwwlint http://...\'',
'wwwdoctype' => 'Reports on the doctype of a webpage. (Warning: Does not check that the doctype is not commented out!) Syntax: \'wwwdoctype http://...\'',
'wwwtitle' => 'Tries to heuristically determine a web page\'s title. Syntax: \'wwwtitle http://...\'',
};
}
sub Told {
my $self = shift;
my ($event, $message) = @_;
if ($message =~ /^\s*wwwsize\s+(.+?)\s*$/osi) {
$self->Fetch($event, $1, 'size');
} elsif ($message =~ /^\s*wwwlint\s+(.+?)\s*$/osi) {
$self->Fetch($event, $1, 'lint');
} elsif ($message =~ /^\s*wwwdoctype\s+(.+?)\s*$/osi) {
$self->Fetch($event, $1, 'doctype');
} elsif ($message =~ /^\s*wwwtitle\s+(.+?)\s*$/osi) {
$self->Fetch($event, $1, 'title');
} else {
return $self->SUPER::Told(@_);
}
return 0; # dealt with it...
}
sub Fetch {
my $self = shift;
my ($event, $uri, $type) = @_;
$self->getURI($event, $uri, $type);
}
sub GotURI {
my $self = shift;
my ($event, $uri, $output, $type) = @_;
my $chars = length($output);
if ($type eq 'size') {
if ($chars) {
$self->say($event, "$uri is $chars bytes long.");
} else {
$self->say($event, "$uri is either empty, or I could not download it.");
}
} elsif ($type eq 'lint') {
# ignore whether things are commented out or not.
unless ($chars) {
$self->say($event, "$uri is either empty, or I could not download it.");
} else {
my @status;
if ($output =~ /document\.all/os) {
push(@status, 'document.all');
}
if ($output =~ /document\.layers/os) {
push(@status, 'document.layers');
}
if ($output =~ /<i?layer/osi) {
push(@status, 'the <layer> tag');
}
if (@status) {
my $status = shift(@status);
if (@status) {
while (scalar(@status) > 1) {
$status .= ', '.shift(@status);
}
$status .= ' and '.shift(@status);
}
$self->say($event, "$uri contains $status.");
} else {
$self->say($event, "$uri doesn't have any _obvious_ flaws..."); # XXX doesn't work! try php.net
}
}
} elsif ($type eq 'doctype') {
# assume doctype is not commented.
unless ($chars) {
$self->say($event, "$uri is either empty, or I could not download it.");
} elsif ($output =~ /(<!DOCTYPE\s[^>]*>)/osi) {
my $doctype = $1;
$doctype =~ s/[\n\r]+/ /gosi;
# -- #mozilla was here --
# <Hixie> it would break 99% of the web if we didn't do it that way.
# <Hixie> including most of my test cases ;-)
# <dbaron> test cases don't matter...
# <dbaron> you'll fix them if we decide they're wrong
# <dbaron> but the web is a problem
if (length($doctype) > 220) { # arbitrary length greater than two 80 character lines
$self->say($event, "$uri has a very long and possibly corrupted doctype (maybe it has an internal subset).");
} else {
$self->say($event, "$uri has the following doctype: $doctype");
}
} else {
$self->say($event, "$uri has no specified doctype.");
}
} elsif ($type eq 'title') {
# assume doctype is not commented.
unless ($chars) {
$self->say($event, "$uri is either empty, or I could not download it.");
} elsif ($output =~ /<title\s*>(.*?)<\/title\s*>/osi or
$output =~ /<h1\s*>(.*?)<\/h1\s*>/osi) {
my $title = $1;
$title =~ s/\s+/ /gosi;
if (length($title) > 100) { # arbitrary length
$title = substr($title, 0, 100) . '...';
}
$self->say($event, "$uri has the following title: " . decode_entities($title));
} else {
$self->say($event, "$uri has no specified title.");
}
} else {
return $self->SUPER::GotURI(@_);
}
}

View File

@@ -1,55 +0,0 @@
################################
# Wishlist Module #
################################
package BotModules::Wishlist;
use vars qw(@ISA);
@ISA = qw(BotModules);
1;
sub Help {
my $self = shift;
my ($event) = @_;
my $reply = {
'' => 'A module to store wishlist items, typically used to file bugs on the bot, but really for that you should use Bugzilla -- https://bugzilla.mozilla.org/ -- component MozBot in product Webtools.',
'wish' => 'Adds an item to the wishlist. Please use Bugzilla for this purpose though, see https://bugzilla.mozilla.org/ product Webtools, component Mozbot. Syntax: \'wish <text of wish>\'',
'wishes' => 'Causes the bot to list all the wishes that have been made. Since this may be long, it may only be done in a /msg. Syntax: \'wishes\'',
};
$$reply{''} .= ' To remove wishes, use the following command: vars Wishlist wishes \'-<full text of the wish to remove>\'' if $self->isAdmin($event);
return $reply;
}
# RegisterConfig - Called when initialised, should call registerVariables
sub RegisterConfig {
my $self = shift;
$self->SUPER::RegisterConfig(@_);
$self->registerVariables(
# [ name, save?, settable? ]
['wishes', 1, 1, []],
['reply', 1, 1, 'Noted!'],
);
}
sub Told {
my $self = shift;
my ($event, $message) = @_;
if ($message =~ /^\s*(?:i\s+)?wish(?:list)?[-\s:.,;!]+(...+?)\s*$/osi) {
push(@{$self->{'wishes'}}, "<$event->{'from'}> $1");
$self->say($event, "$event->{'from'}: $self->{'reply'}");
$self->saveConfig();
} elsif ($message =~ /^\s*wishes[\s?]*$/osi) {
if (@{$self->{'wishes'}}) {
$self->directSay($event, 'Wishes:');
foreach (@{$self->{'wishes'}}) {
$self->directSay($event, " $_");
}
$self->directSay($event, 'End of wishes.');
} else {
$self->directSay($event, 'No-one has wished for anything!');
}
$self->channelSay($event, "$event->{'from'}: wishlist /msg'ed");
} else {
return $self->SUPER::Told(@_);
}
return 0; # we've dealt with it, no need to do anything else.
}

View File

@@ -1,219 +0,0 @@
# -*- Mode: perl; tab-width: 4; indent-tabs-mode: nil; -*-
################################
# XMLLogger Module #
################################
# Original Author: Matt Jones
# National Center for Ecological Analysis and Synthesis (NCEAS)
# University of California Santa Barbara
#
# This package creates an XML log file of the messages sent to IRC channels
# which mozbot has joined. The content that is logged can be selected using
# regular expression filters, although by default all messages are logged
package BotModules::XMLLogger;
use vars qw(@ISA);
@ISA = qw(BotModules);
1;
sub Help {
my $self = shift;
my ($event) = @_;
my $help = {
'' => 'This module keeps an XML log of channels.',
};
if ($self->isAdmin($event)) {
$help->{''} .= ' It can be configured to only accept messages matching certain patterns. The \'acceptedPatterns\' module variable is a list of regular expressions to use when determining what to log. The \'blockedPatterns\' list is the opposite.';
$help->{'rotatelogs'} = 'Creates a new log file for each channel and moves the old one to a date-stamped version, making sure that the XML is valid. Syntax: \'rotatelogs\'.';
}
return $help;
}
# RegisterConfig - Called when initialised, should call registerVariables
sub RegisterConfig {
my $self = shift;
$self->SUPER::RegisterConfig(@_);
$self->registerVariables(
# [ name, save?, settable? ]
['acceptedPatterns', 1, 1, ['']], # by default match everything
['blockedPatterns', 1, 1, []], # by default block nothing
);
}
sub Told {
my $self = shift;
my ($event, $message) = @_;
if ($self->isAdmin($event)) {
if ($message =~ /^\s*rotate\s*logs?\s*$/osi) {
$self->RotateLogs($event);
} else {
return $self->SUPER::Told(@_);
}
} else {
return $self->SUPER::Told(@_);
}
return 0; # we've dealt with it, no need to do anything else.
}
sub Log {
my $self = shift;
my ($event) = @_;
if (($event->{'firsttype'} eq 'Told') or
($event->{'firsttype'} eq 'Heard')) {
$self->DoLog($event, 'msg');
} elsif (($event->{'firsttype'} eq 'Felt') or
($event->{'firsttype'} eq 'Saw')) {
$self->DoLog($event, 'emote');
} elsif (($event->{'firsttype'} eq 'SpottedKick') or
($event->{'firsttype'} eq 'Kicked')) {
$self->DoLog($event, 'kick');
} elsif ($event->{'firsttype'} eq 'SpottedPart') {
$self->DoLog($event, 'part');
} elsif ($event->{'firsttype'} eq 'SpottedQuit') {
$self->DoLog($event, 'quit');
} elsif ($event->{'firsttype'} eq 'SpottedJoin') {
$self->DoLog($event, 'join');
} elsif ($event->{'firsttype'} eq 'SpottedNickChange') {
$self->DoLog($event, 'nick');
} elsif ($event->{'firsttype'} eq 'ModeChange') {
$self->DoLog($event, 'mode');
} elsif ($event->{'firsttype'} eq 'SpottedTopicChange') {
$self->DoLog($event, 'topic');
} # XXX should log notices
return $self->SUPER::Log(@_);
}
sub DoLog {
my $self = shift;
my ($event, $messageType) = @_;
if ($event->{'channel'} ne '') { # don't log private messages
foreach my $pattern (@{$self->{'acceptedPatterns'}}) {
my $regexp = $self->sanitizeRegexp($pattern);
if (($regexp eq '') ||
($event->{'fulldata'} =~ /$regexp/s) ||
($event->{'from'} =~ /$regexp/s)) {
# wohay, we have a candidate!
# now check for possible blockers...
unless ($self->isBlocked($event)) {
$self->WriteMessage($event->{'time'},
$event->{'channel'},
$event->{'from'},
$event->{'fulldata'},
$messageType);
return; # only store each message once, regardless of how many patterns it matches
}
}
}
}
}
sub isBlocked {
my $self = shift;
my ($event) = @_;
foreach my $blockedPattern (@{$self->{'blockedPatterns'}}) {
my $regexp = $self->sanitizeRegexp($blockedPattern);
if ($event->{'data'} =~ /$regexp/s) {
return 1;
}
}
return 0;
}
sub WriteMessage {
my $self = shift;
my ($time, $channel, $from, $message, $messageType) = @_;
# Open the log file and append the message
$channel = $self->sanitiseChannelName($channel);
my $logName = $self->getLogFilename("$channel.xml.part");
if (open(LOG, ">>$logName")) {
my $msgtime = $self->logdate($time);
# sanitise the output
$_ = $self->escapeXML($_) for ($messageType, $channel, $from, $msgtime, $message);
print LOG "<$messageType channel=\"$channel\" nick=\"$from\" time=\"$msgtime\">$message</$messageType>\n";
close(LOG);
} else {
$self->debug("Error logging, failed to open log $logName");
}
}
sub RotateLogs {
my $self = shift;
my ($event) = @_;
my $errors = 0;
foreach my $channel (@{$self->{'channels'}}) {
$self->debug("Rotating log for $channel...");
# XXX could (optionally) output message to channel saying so
$errors += $self->RotateLogFile($event, $channel);
}
$errors = $errors == 1 ? "$errors error" : "$errors errors";
$self->say($event, "Finished rotating logs, $errors.");
}
sub RotateLogFile {
my $self = shift;
my ($event, $channel) = @_;
# create new names
$channel = $self->sanitiseChannelName($channel);
my $time = $self->filedate($event->{'time'});
my $partName = $self->getLogFilename("$channel.xml.part");
my $finalName = $self->getLogFilename("$channel-$time.xml");
# try to finalise file
if (-e $finalName) {
$self->debug("error rotating log for $channel, destination already existed");
return 1; # report error
} elsif (not (-e $partName and -s $partName)) {
$self->debug("skipping $channel log rotation, log was empty");
return 0; # not an error condition
} elsif (open(FinalLog, ">$finalName")) {
# opened new file, add the XML and copy the data over
print FinalLog "<?xml version=\"1.0\"?>\n"; # XXX optional -- do we really want to add this?
print FinalLog "<irclog>\n";
open(PartLog, "<$partName"); # XXX error checking
while (defined($_ = <PartLog>)) {
print FinalLog;
}
close(PartLog);
print FinalLog "</irclog>";
close(FinalLog);
unlink($partName); # delete the part log, ready for new data
} else {
$self->debug("error rotating log for $channel, failed to open $finalName");
return 1; # doh, report error
}
return 0
}
# logdate: return nice looking date and time stamp
sub logdate {
my $self = shift;
my ($sec, $min, $hour, $mday, $mon, $year) = gmtime(shift or time());
return sprintf("%d-%02d-%02dT%02d:%02d:%02dZ", $year + 1900, $mon + 1, $mday, $hour, $min, $sec);
}
# return a date and time stamp suitable for file names
sub filedate {
my $self = shift;
my ($sec, $min, $hour, $mday, $mon, $year) = gmtime(shift or time());
return sprintf('%d%02d%02d-%02d%02d%02d', $year + 1900, $mon + 1, $mday, $hour, $min, $sec);
}
sub sanitiseChannelName {
my $self = shift;
my($channel) = @_;
$channel =~ s/([^\#&+a-zA-Z0-9-])//gosi; # sanitize
$channel =~ m/^(.*)$/os; # detaint
return $1;
}
# escape XML characters as needed
sub escapeXML {
my $self = shift;
my ($string) = @_;
$string =~ s/&/&amp;/gos;
$string =~ s/'/&apos;/gos;
$string =~ s/"/&quot;/gos;
$string =~ s/</&lt;/gos;
$string =~ s/>/&gt;/gos;
return $string;
}

View File

@@ -1,993 +0,0 @@
MODULE API DOCUMENTATION
========================
This file documents the mozbot 2.5 bot module API.
Revisions are welcome.
Sample module
-------------
Here is the HelloWorld module:
################################
# Hello World Module #
################################
package BotModules::HelloWorld;
use vars qw(@ISA);
@ISA = qw(BotModules);
1;
sub Help {
my $self = shift;
my ($event) = @_;
return {
'' => 'This is the demo module that says Hello World.',
'hi' => 'Requests that the bot emit a hello world string.',
};
}
sub Told {
my $self = shift;
my ($event, $message) = @_;
if ($message =~ /^\s*hi\s*$/osi) {
$self->say($event, 'Hello World!');
} else {
return $self->SUPER::Told(@_);
}
}
################################
Creating a module
-----------------
Modules are perl objects with names that start with 'BotModules::'
and that are stored in files with the '.bm' extension in the
'BotModules' directory. The first non-comment line of each module
should be the 'package' line, which in the HelloWorld module reads:
package BotModules::HelloWorld;
For a module to work correctly, it should inherit from the
'BotModules' module (which is implemented internally in the main bot
executable). This is done by including the following two lines
immediately after the 'package' line:
use vars qw(@ISA);
@ISA = qw(BotModules);
Since modules are dynamically loaded and unloaded, they should avoid
using package globals. All variables should be stored in the '$self'
blessed hashref. For more details, see the documentation of the
'Initialise' function (below). Another result of the dynamic nature
of modules is that they should not use BEGIN {} or END {} blocks, nor
should they execute any code during their evaluation. Thus,
immediately after the @ISA... line, the module should return success.
This can be done easily:
1;
Following this, you are free to implement all the functions you need
for your module. Certain functions have certain calling semantics,
these are described below.
Module Functions
----------------
This section contains the names and descriptions of the functions in
your module that will be called automatically depending on what is
happening on IRC.
All your functions should start by shifting the $self variable from
the argument list:
my $self = shift;
After this, it is common to get the other variables too:
my ($event, @anythingElse) = @_;
...where the bit in the brackets is given in the brackets of the
definitions of the functions as shown below. For example, for
JoinedChannel it would be ($event, $channel), so a function to
override the default JoinedChannel action would be something like:
sub JoinedChannel {
my $self = shift;
my ($event, $channel) = @_;
# ...
return $self->SUPER::JoinedChannel($event, $channel); # call inherited method
}
Many functions have to return a special value, typically 0 if the
event was handled, and 1 if it was not.
For these functions, what actually happens is that for the relevant
event, the bot has a list of event handlers it should call. For
example, if someone says 'bot: hi' then the bot wants to call the
Told() handler and the Baffled() handler. It first calls the Told()
handler of every module. It then looks to see if any of the handlers
returned 0. If so, it stops. Note, though, that every Told() handler
got called! If none of the handlers returned 0, then it looks to see
what the highest return value was. If it was greater than 1, then it
increments the 'level' field of the $event hash (see below) and calls
all the Told() handlers that returned 1 or more again. This means that
if your module decides whether or not to respond by looking at a
random number, it is prone to being confused by another module!
YOU SHOULD NOT USE RANDOM NUMBERS TO DECIDE WHETHER OR NOT TO
RESPOND TO A MESSAGE!
Once all the relevant Told() handlers have been called again, the
bot once again examines all the return results, and stops if any
returned 0. If none did and if the current value of the level field
is less than the highest number returned from any of the modules,
then it repeats the whole process again. Once the level field is
equal to the highest number returned, then, if no module has ever
returned 0 in that whole loopy time, it moves on to the next
handler in the list (in this case Baffled()), and does the
_entire_ process again.
You may be asking yourself "Why oh why!". It is to allow you to
implement priority based responses. If your module returns '5' to
the Told() function, and only handles the event (i.e., only
returns 0) once the level field is 5, then it will only handle the
event if no other module has wanted to handle the event in any of
the prior levels.
It also allows inter-module communication, although since that is
dodgy, the details are left as an exercise to the reader.
Important: if you use this, make sure that you only reply to the
user once, based on the $event->{'level'} field. e.g., if you
replied when level was zero, then don't reply _again_ when it is
set to 1. This won't be a problem if your module only returns 1
(the default) or 0 (indicating success).
*** Help($event)
Every module that does anything visible should provide a 'Help'
function. This is called by the General module's 'help' command
implementation.
This function should return a hashref, with each key representing a
topic (probably a command) and each value the relevant help string.
The '' topic is special and should contain the help string for the
module itself.
*** Initialise()
Called when the module is loaded.
No special return values.
*** Schedule($event)
Schedule - Called after bot is set up, to set up any scheduled
tasks. See 'schedule' in the API documentation below for information
on how to do this.
No special return values. Always call inherited function!
*** JoinedIRC($event)
Called before joining any channels (but after module is setup). This
does not get called for dynamically installed modules.
No special return values. Always call inherited function!
*** JoinedChannel($event, $channel)
Called after joining a channel for the first time, for example if
the bot has been /invited.
No special return values. Always call inherited the function, as this
is where the autojoin function is implemented.
*** PartedChannel($event, $channel)
Called after the bot has left a channel, for example if the bot has
been /kicked.
No special return values. Always call inherited the function, as this
is where the autopart function is implemented.
*** InChannel($event)
Called to determine if the module is 'in' the channel or not.
Generally you will not need to override this.
Return 0 if the module is not enabled in the channel in which the
event occured, non zero otherwise.
*** IsBanned($event)
Same as InChannel(), but for determining if the user is banned or
not.
Return 1 if the user that caused the event is banned from this
module, non zero otherwise.
*** Log($event)
Called once for most events, regardless of the result of the
other handlers. This is the event to use if you wish to log
everything that happens on IRC (duh).
No return value.
*** Baffled($event, $message)
Called for messages prefixed by the bot's nick which we don't
understand (i.e., that Told couldn't deal with).
Return 1 if you can't do anything (this is all the default
implementation of Baffled() does).
*** Told($event, $message)
Called for messages heard that are prefixed by the bot's nick. See
also Baffled.
Return 1 if you can't do anything (this is all the default
implementation of Told() does).
*** Heard($event, $message)
Called for all messages not aimed directly at the bot, or those
aimed at the bot but with no content (e.g., "bot!!!").
Return 1 if you can't do anything (this is all the default
implementation of Heard() does).
*** Noticed($event, $message)
Called for all 'notice' messages, whether aimed directly at the bot
or not. Don't use this message to trigger responses! Doing so is a
violation of the IRC protocol.
To quote RFC 1459:
# [...] automatic replies must never be sent in response to a NOTICE
# message. [...] The object of this rule is to avoid loops between a
# client automatically sending something in response to something it
# received. This is typically used by automatons (clients with either
# an AI or other interactive program controlling their actions) which
# are always seen to be replying lest they end up in a loop with
# another automaton.
Return 1 if you can't do anything (this is all the default
implementation of Noticed() does).
*** Felt($event, $message)
Called for all emotes containing bot's nick.
Return 1 if you can't do anything (this is all the default
implementation of Felt() does).
*** Saw($event, $message)
Called for all emotes except those directly at the bot.
Return 1 if you can't do anything (this is all the default
implementation does).
*** Invited($event, $channel)
Called when bot is invited into another channel.
Return 1 if you can't do anything (this is all the default
implementation does).
*** Kicked($event, $channel)
Called when bot is kicked out of a channel.
Return 1 if you can't do anything (this is all the default
implementation does).
*** ModeChange($event, $what, $change, $who)
Called when either the channel or a person has a mode flag changed.
Return 1 if you can't do anything (this is all the default
implementation does).
*** GotOpped($event, $channel, $who)
Called when the bot is opped. (Not currently implemented.)
Return 1 if you can't do anything (this is all the default
implementation does).
*** GotDeopped($event, $channel, $who)
Called when the bot is deopped. (Not currently implemented.)
Return 1 if you can't do anything (this is all the default
implementation does).
*** Authed($event, $who)
Called when someone authenticates with us. Note that you cannot
do any channel-specific operations here since authentication is
done directly and without any channels involved. (Of course,
you can always do channel-wide stuff based on a channel list...)
Return 1 if you can't do anything (this is all the default
implementation does).
*** SpottedNickChange($event, $from, $to)
Called when someone changes their nick. You cannot use directSay
here, since $event has the details of the old nick. And 'say' is
useless since the channel is the old userhost string... This may be
changed in a future implementation.
Return 1 if you can't do anything (this is all the default
implementation does).
*** SpottedTopicChange($event, $channel, $newtopic)
Called when the topic in a channel is changed.
Return 1 if you can't do anything (this is all the default
implementation does).
*** SpottedJoin($event, $channel, $who)
Called when someone joins a channel (including the bot).
Return 1 if you can't do anything (this is all the default
implementation does).
*** SpottedPart($event, $channel, $who)
Called when someone leaves a channel (including the bot).
Return 1 if you can't do anything (this is all the default
implementation does).
*** SpottedKick($event, $channel, $who)
Called when someone leaves a channel, um, forcibly (including the
bot).
Return 1 if you can't do anything (this is all the default
implementation does).
*** SpottedQuit($event, $who, $why)
Called when someone leaves a server. You can't use say or directSay
as no channel involved and the user has quit, anyway (obviously).
This may change in future implementations (don't ask me how, please...).
This does not get called for the bot itself. There is no way to
reliably detect this (the core code itself has difficulty detecting
this case, and sometimes only detects it when it is not really in a
position to call into the modules). You may wish to use the 'unload'
handler or 'DESTROY' function instead.
Return 1 if you can't do anything (this is all the default
implementation does).
*** SpottedOpping($event, $channel, $who)
Called when someone is opped. (Not currently implemented.)
Return 1 if you can't do anything (this is all the default
implementation does).
*** SpottedDeopping($event, $channel, $who)
Called when someone is... deopped, maybe? (Not currently implemented.)
Return 1 if you can't do anything (this is all the default
implementation does).
*** CTCPPing($event, $who, $what)
Called when the bot receives a CTCP ping.
Return 1 if you can't do anything (this is all the default
implementation does).
*** CTCPVerson($event, $who, $what)
Called when the bot receives a CTCP verson.
Return 1 if you can't do anything (this is all the default
implementation does).
*** CTCPSource($event, $who, $what)
Called when the bot receives a CTCP source.
Return 1 if you can't do anything (this is all the default
implementation does).
*** Scheduled($event, @data)
Called when a scheduled timer triggers. (See 'schedule' in the next
section to see how to schedule stuff.) By default, if the first
element of the @data array is a coderef, then the coderef is called
with ($event,@data) as the arguments. Otherwise, 'debug' is called
(see below).
No special return values. Always call inherited function if you
cannot handle the scheduled event yourself.
*** GotURI($event, $uri, $contents, @data)
Called when a requested URI has been downloaded. $contents contains
the actual contents of the file. See getURI().
No special return values.
*** ChildCompleted($event, $type, $output, @data)
Called when a spawned child has completed. $output contains
the output of the process. $type contains the child type as
given to the spawnChild() API function (which see).
No special return values. Always call the inherited function if
you cannot handle the given '$type'!
*** DataAvailable($event, $handle, $data, $closed)
Called when $handle has data available. See registerDataHandle().
$data is the string that was read from the handle. Don't perform
blocking read I/O on $handle, since all the data that was available
has been read. (The handle is only returned because it is expected
you will use that as a key to work out who is talking to you.)
The $closed argument will be set to true if the handle is now closed.
No special return values. Make sure to call the inherited function if
you did not expect to see data on the specified $handle.
*** RegisterConfig()
Called when initialised, should call registerVariables(), which see
below.
No special return values. Always call inherited function!
*** Set($event, $variable, $value)
Called to set a variable to a particular value.
Should return one of the following:
-1 - silent success (caller should not report back to user)
0 - success
1 - can't set variable because it is of type ref($module->{$variable})
2 - variable not found or not writable (if $module->{$variable})
3 - variable is list and wrong format was used
4 - variable is hash and wrong format was used
9 - unknown error
Note that error codes 1-4 are probably too specific to the default
'Set' function to be of any use. Reporting your own error messages
is fine.
Always call inherited function if you cannot set the variable yourself!
*** Get($event, $variable)
Called to get a particular variable.
Should return the value of the variable. Default returns the value
of $self->{$variable}.
Always call inherited function if you cannot get the variable yourself!
*** Unload()
Called when the module is unloaded. However, this is not always
reliably called when the module is unloaded immediately prior to the
bot shutting down or branching to a different process.
In general, relying on this function is poor design. It should only
really be used for things like untie-ing from hashes or disconnecting
from databases, where the code executing is not critical, merely good
manners or helpful.
No special return values. You are encouraged not to use this method.
It is documented for completeness only.
Default implementation does nothing.
The $event variable is a hash with the following keys:
'bot' => the IRC bot object - DO NOT USE THIS!!! [1]
'channel' => the channel the event occured in, or '' if n/a [2]
'from' => the nick of the person who created the event, if any
'target' => the target of the 'say' function (channel || from)
'user' => the userhost of the event
'data' => the main data of the event
'fulldata' => the data of the event before it got mangled [3]
'to' => the target of the event
'subtype' => the IRC module's idea of what the event was [1]
'maintype' => the name of the first handler called (eg. 'Told')
'level' => the number of times the handler has been called in a row
'userName' => the name of the user as they authenticated
'userFlags' => used internally for the implementation of isAdmin() [1]
'nick' => the nick of the bot
'time' => the value of time() when the event was constructed [4]
It is passed to most functions, as the first parameter. Modify at your
own risk! ;-) If you do write to this hash at all, ensure that you make
a 'local' copy first. See the 'Parrot' module for an example of safely
modifying the $event hash. Note that some of these fields may be
inaccurate at times, due to peculiarities of the IRC protocol.
[1]: These fields are dependent on the underlying implementation, so
if you use them then your modules will not be compatible with any other
implementations that use the same API. The 'bot' field in particular is
a blessed reference to a Net::IRC::Connection object in this
implementation, and is passed around so that the API functions know
what to operate on. However, in a POE implementation it could be
something totally different, maybe even undef. There are some other
fields in the $event hash that start with an underscore (in particular
there is '_event'). Do not even _think_ about using those. Using them
is akin to hard-coding the ionode of the 'ls' program into your source
so that you can read directories by branching to a disk address.
[2]: The 'channel' field is ALWAYS lowercase. You should always lowercase
any channel names you get from users before using them in comparisons or
hash lookups.
[3]: This is the same as the 'data' slot except for Told and Baffled
events where it also contains the prefix that was stripped.
[4]: Use this instead of calling time() so as to avoid time drift when
comparing times at various points.
Module API
----------
This section contains the names and descriptions of the functions
that your module can call. While you can override these, it is not
recommended.
*** debug(@messages)
Outputs each item in @messages to the console (or the log file if
the bot has lost its controlling tty).
Example:
$self->debug('about to fetch listing from FTP...');
*** saveConfig()
Saves the state of the module's registered variables to the
configuration file. This should be called when the variables have
changed.
Example:
$self->saveConfig(); # save our state!
*** registerVariables( [ $name, $persistent, $settable, $value ] )
Registers variables (duh). It actually takes a list of arrayrefs.
The first item in each arrayref is the name to use (the name of the
variable in the blessed hashref that is the module's object, i.e.
$self). The second controls if the variable is saved when
saveConfig() is called. If it is set to 1 then the variable is
saved, if 0 then it is not, and if undef then the current setting is
not changed. Similarly, the third item controls whether or not the
variable can be set using the 'vars' command (in the Admin
module). 1 = yes, 0 = no, undef = leave unchanged. The fourth value,
if defined, is used to set the variable. See the Initialise
function's entry for more details.
Example:
$self->registerVariables(
[ 'ftpDelay', 1, 1, 60 ],
[ 'ftpSite', 1, 1, 'ftp.mozilla.org' ],
);
Only simple scalars, references to arrays of scalars, and references
to hashes of scalars, can be stored in registered variables.
*** schedule($event, $time, $times, @data)
Schedules one or more events. $event is the usual event hash. $time
is the number of seconds to wait. It can be a scalarref to a
variable that contains this number, too, in which case it is
dereferenced. This comes in useful for making the frequency of
repeating events customisable. $times is the number of times to
perform the event, which can also be -1 meaning 'forever'. @data
(the remainder of the parameters) will be passed, untouched, to the
event handler, Scheduled. See the previous section.
Example:
$self->schedule($event, \$self->{'ftpDelay'}, -1, 'ftp', \$ftpsite);
*** getURI($event, $uri, @data)
Gets a URI in the background then calls GotURI (which see, above).
Example:
$self->getURI($event, $ftpsite, 'ftp');
*** spawnChild($event, $command, $arguments, $type, $data)
Spawns a child in the background then calls ChildCompleted (which see,
above). $arguments and $data are array refs! $command is either a
command name (e.g., 'wget', 'ls') or a CODEREF. If it is a CODEREF,
then you will be wanting to make sure that the first argument is
the object reference, unless we are talking inlined code or something...
Example:
$self->spawnChild($event, '/usr/games/fortune', ['-s', '-o'],
'fortune', [@data]);
*** registerDataHandle($event, $handle)
Adds $handle to the list of file handles and sockets to watch. When
data is available on that socket, DataAvailable() will be called.
*** getModule($name)
Returns a reference to the module with the given name. In general you
should not need to use this, but if you write a management module, for
instance, then this could be useful. See God.bm for an example of this.
IT IS VITAL THAT YOU DO NOT KEEP THE REFERENCE
THAT THIS FUNCTION RETURNS!!!
If you did so, the module would not get garbage collected if it ever
got unloaded or some such.
Example:
my $module = $self->getModule('Admin');
push(@{$module->{'files'}}, 'BotModules/SupportFile.pm');
*** getModules()
Returns the list of module names that are loaded, in alphabetical
order, which you can then use with getModule().
Example:
my @modulenames = $self->getModules();
local $" = ', ';
$self->ctcpReply($event, 'VERSION', "mozbot $VERSION (@modulenames)");
*** getMessageQueue()
Returns a reference to the message queue. Manipulating this is
probably not a good idea. In particular, don't add anything to this
array, use the say(), directSay(), channelSay(), announce(),
tellAdmin(), etc, methods defined below.
Each item in this array is an array ref, consisting of three
subitems. The first subitem is a scalar with the name of the channel
or nick targetted, the second is the message to send, and the third
is a scalar equal to one of: 'msg', 'me', 'notice', 'ctcpSend',
'ctcpReply'. The second subitem is a scalar, except in the case of
'ctcpSend' messages, in which case it's an array ref consisting of
first the type of the CTCP message, and then the data.
Note: Don't use 'delete' to remove items from this array, since that
leaves undefs in the array, which will later cause a crash.
Example:
my $queue = $self->getMessageQueue();
foreach my $message (@$queue) {
++$count if $message->[0] eq $event->{'from'};
}
*** getHelpLine()
Returns the bot's help line.
Example:
$self->say($event, $self->getHelpLine());
*** getLogFilename($name)
Returns a filename (with path) appropriate to use for logging. $name
should be the filename wanted, without a path.
Example:
my $logName = $self->getLogFilename("$channel.log");
if (open(LOG, ">>$logName")) {
print LOG $data;
close LOG;
} else {
# XXX error handling
}
*** unescapeXML($xml)
Performs the following conversions on the argument and returns the result:
&apos; => '
&quot; => "
&lt; => <
&gt; => >
&amp; => &
Example:
my $text = $self->unescapeXML($output);
*** tellAdmin($event, $data);
Tries to tell an administrator $data. As currently implemented, only
one administrator will get the message, and there is no guarentee
that they will read it or even that the admin in question is
actually on IRC at the time.
Example:
$self->tellAdmin($event, 'Someone just tried to crack me...');
*** say($event, $data)
Says $data in whatever channel the event was spotted in (this can be
/msg if that is how the event occured).
Example:
$self->say($event, 'Yo, dude.');
*** announce($event, $data)
Says $data in all the channels the module is in.
Example:
$self->announce($event, 'Bugzilla is back up.');
*** directSay($event, $data)
Sends a message directly to the cause of the last event (i.e., like
/msg). It is recommended to use 'say' normally, so that users have a
choice of whether or not to get the answer in the channel (they
would say their command there) or not (they would /msg their
command).
Example:
$self->directSay($event, 'Actually, that\'s not right.');
*** channelSay($event, $data)
Sends a message to the channel in which the message was given.
If the original command was sent in a /msg, then this will result
in precisely nothing. Useful in conjunction with directSay() to
make it clear that a reply was sent privately.
Example:
$self->directSay($event, $veryLongReply);
$self->channelSay($event, "$event->{'from'}: data /msg'ed");
*** emote($event, $what)
*** directEmote($event, $what)
Same as say() and directSay(), but do the equivalent of /me instead.
Examples:
$self->emote($event, "slaps $event->{'from'} with a big smelly trout.");
$self->directEmote($event, "waves.");
*** sayOrEmote($event, $what)
*** directSayOrEmote($event, $what)
Call say (directSay) or emote (directEmote) based on the contents of $what.
If $what starts with '/me' then the relevant emote variation is called,
otherwise the say variations are used. The leading '/me' is trimmed before
being passed on.
Examples:
$self->sayOrEmote($event, $greeting);
$self->directSayOrEmote($event, $privateMessage);
*** ctcpSend($event, $type, $data)
Same as say() but for sending CTCP messages.
Examples:
$self->ctcpSend($event, 'PING', $event->{'time'});
*** ctcpReply($event, $type, $data)
Same as ctcpSend() but for sending CTCP replies.
Examples:
$self->ctcpReply($event, 'VERSION', "Version $major.$minor");
*** notice($event, $data)
Sends a notice containing $data to whatever channel the event was
spotted in (this can be /msg if that is how the event occured).
Example:
foreach (@{$self->{'channels'}}) {
local $event->{'target'} = $_;
$self->notice($event, 'This is a test of the emergency announcement system.');
}
*** isAdmin($event)
Returns true if the cause of the event was an authenticated administrator.
Example:
if ($self->isAdmin($event)) { ... }
*** setAway($event, $message)
Set the bot's 'away' flag. A blank message will mark the bot as
back. Note: If you need this you are doing something wrong!!!
Remember that you should not be doing any lengthy processes since if
you are away for any length of time, the bot will be disconnected!
Also note that in 2.0 this is not throttled, so DO NOT call this
repeatedly, or put yourself in any position where you allow IRC
users to cause your module to call this. Otherwise, you open
yourself to denial of service attacks.
Finally, note that calling 'do', 'emote', 'say', and all the
related functions will also reset the 'away' flag.
Example:
$self->setAway($event, 'brb...');
*** setNick($event, $nick)
Set the bot's nick. This handles all the changing of the internal
state variables and saving the configuration and everything.
It will also add the nick to the list of nicks to try when
the bot finds its nick is already in use.
Note that in 2.0 this is not throttled, so DO NOT call this
repeatedly, or put yourself in any position where you allow IRC
users to cause your module to call this. Otherwise, you open
yourself to denial of service attacks.
Example:
$self->setNick($event, 'zippy');
*** mode($event, $channel, $mode, $argument)
Changes a mode of channel $channel.
Example:
$self->mode($event, $event->{'channel'}, '+o', 'Hixie');
*** invite($event, $who, $channel)
Invite $who to channel $channel. This can be used for intrabot
control, or to get people into a +i channel, for instance.
Example:
$self->invite($event, 'Hixie', '#privateChannel');
*** prettyPrint($preferredLineLength, $prefix, $indent, $divider, @input)
Takes @input, and resorts it so that the lines are of roughly the same
length, aiming optimally at $preferredLineLength, prefixing each line
with $indent, placing $divider between each item in @input if they
appear on the same line, and sticking $prefix at the start of it all on
the first line. The $prefix may be undef.
Returns the result of all that.
This is what the 'help' command uses to pretty print its output.
This is basically the same as wordWrap() but it can change the order
of the input.
Example:
my @result = $self->prettyPrint($linelength, undef, 'Info: ', ' -- ', @infoItems);
*** wordWrap($preferredLineLength, $prefix, $indent, $divider, @input)
Takes @input, and places each item sequentially on lines, aiming optimally
at $preferredLineLength, prefixing each line with $indent, placing $divider
between each item in @input if they appear on the same line, and sticking
$prefix at the start of it all on the first line, without ever cutting
items across lines. The $prefix may be undef.
Returns the result of all that.
This is basically the same as prettyPrint() but it doesn't change the
order of the input.
Example:
my @result = $self->wordWrap($linelength, undef, 'Info: ', ' ', split(/\s+/os, @lines);
*** days($time)
Returns a string describing the length of time between $time and now.
Example:
$self->debug('uptime: '.$self->days($^T));
*** sanitizeRegexp($regexp)
Checks to see if $regexp is a valid regular expression. If it is, returns
the argument unchanged. Otherwise, returns quotemeta($regexp), which should
be safe to use in regular expressions as a plain text search string.
Do not add prefixes or suffixes to the pattern after sanitizing it.
Example:
$pattern = $self->sanitizeRegexp($pattern);
$data =~ /$pattern//gsi;
-- end --

View File

@@ -1,443 +0,0 @@
_ _
m o z i l l a |.| o r g | |
_ __ ___ ___ ___| |__ ___ | |_
| '_ ` _ \ / _ \_ / '_ \ / _ \| __|
| | | | | | (_) / /| |_) | (_) | |_
|_| |_| |_|\___/___|_.__/ \___/ \__|
====================================
INSTALLATION
------------
You will need the following programs and libraries to run mozbot2:
perl
wget
Net::IRC
Net::SMTP
IO::Select
IO::Pipe
These packages may have additional requirements of their own.
In order to do anything useful with mozbot2, you will need some Bot
Modules. Several are included in this distribution, and they may have
requirements above and beyond those given above.
Once you have set up all the packages on which mozbot2 depends, make
mozbot.pl executable:
chmod +x mozbot.pl
This is needed since mozbot2 will occasionally attempt to restart
itself (e.g. if its source code is changed).
Then, simply run mozbot.pl:
./mozbot.pl
Currently, you MUST run mozbot from the directory in which mozbot.pl
is placed. This may be changed in a future version.
SECURITY
--------
Since mozbot interacts with the outside world, do not run it as a
privileged user!!!
In addition, since mozbot calls external programs (currently perl and
wget, possibly others in future versions) make sure that none of the
directories on your path are writable by untrusted users! (e.g., do
not put /tmp into your path!)
Make sure that '.' is not in your path! This is a security risk in a
situation like this, and perl will rightly refuse to execute external
programs (like wget, used to get remote URIs for many functions) if
'.' is on your path.
Do not run the bot straight into a public channel on the first run!
One important reason not to load the bot straight into a public
channel on the first run is that until it has been properly
configured, it will have a well defined username and password to
access all its admin functions. Thus a malicious user could hijack the
bot the moment it joined the channel.
If this is a serious problem for you (e.g., your users are of a
particularly high calibre and are doing regular polls of the /who
command to see if any bots join) then use another server, such as one
that you control, on localhost!
See the "Administration" section for instructions on how to change the
administration password (important!).
Note: Passwords are printed in clear text on the console and in the
log files. Secure them accordingly. Of course, IRC is an inherently
insecure protocol anyway, and any machine between your IRC client's
and your bot's, going through the IRC network's servers, will have
access to the passwords. For this reason, change them often, and don't
use passwords that you use for important things here.
The default setting is for mozbot to run with taint checking
enabled. I *STRONGLY* recommend not changing this.
CONFIGURATION
-------------
When you start up mozbot for the first time, it will prompt you for
the following information:
1. IRC server.
What machine you want the bot to connect to. At the moment,
mozbot only supports connecting to a single server at a time. It
would require a *significant* amount of work to change this.
2. Port.
What port to connect to on the IRC server. Typically, this will
be 6667 or therabouts.
3. Password.
If your server has a password, enter it here. If there isn't one
(and this is almost certainly the case) then just hit enter.
4. Channels.
What channels the bot should initially connect to. It is
recommended that this just be a bot channel or a test channel,
for example #mozbot, since running a bot for the first time
before it is known to be ready is a bad idea. You can enter more
than one channel, just hit enter after each one (leave a blank
line when you have finished). (To make mozbot join a keyed
channel, you must first add the channel's key to the
'channelKeys' variable. To do this, the bot will have to be on
IRC first, so don't worry about it for now.)
5. Your e-mail address.
In case of great difficulties, mozbot may try to e-mail you. If
this happens, it will use the e-mail address you gave here. This
only happens if (a) it absolutely cannot connect to the server
you gave it, or (b) it cannot find a nick that is not in use.
6. SMTP server.
The name of the SMTP server it should try to talk with in order
to send you mail. If you type in an invalid server name, it will
just fail to send mail and instead will complain bitterly to its
console.
7. Nicks.
Some nicks for IRC. For example, 'mozbot'. It is customary to
clearly mark the bot as being non-human, for example by putting
'bot' in the name. You should enter several possibilities
here. Hit enter after each one. Leave a blank line to finish.
Once the bot is running, there are many other things that can be
configured with it. See "variables".
Note. The bot will treat all channel names as lowercase to avoid case
sensitivity issues.
LOGGING
-------
Normally, mozbot will output its complaints to the console
(stdout). If you run mozbot in an xterm or screen session, you can
therefore easily keep track of what is going on.
It will also continuously log output to ~/logs/$0.$$.log, where $0 is
the file name and $$ is the PID. You may wish to set up a cron job to
prune this file on a regular basis, it gets LARGE. However, it can
sometimes be the only way to track down how your system was
compromised if it turns out that mozbot has a security flaw.
Control over the logging is currently not available. This may change
in future versions.
Note that when the bot forks and then outputs a message, which happens
occasionally, it will therefore use a new log file for the forked
process. This should only happen when something bad happens,
e.g. something forces the bot to restart or the bot forks and then the
child enters a bad state.
Note. Authentication passwords will be displayed in cleartext on the
console and in the log files.
ADMINISTRATION
--------------
Once the bot is active and on the IRC server, it starts to listen to
all messages seen on any channels on which it is present, and all
messages sent to it using /msg.
Your first task should be to change the admin password. To do this,
authenticate yourself using the "auth" command. The default username
is "admin", and the default password is "password". If the bot is
called "mozbot", then the command to authenticate would be as follows:
/msg mozbot auth admin password
The bot should respond with "Hi admin!".
Now create yourself an account by adding a username/password pair to
the bot. You do this with the "newuser" command. Next, you should
bless this new user, making it a bot administrator. This is done using
these commands:
/msg mozbot newuser <username> <password> <password>
/msg mozbot bless <username>
Now authenticate yourself again, as the new user:
/msg mozbot auth <username> <password>
The moment you authenticate as the new admin, the default admin
account is deleted.
You are now in a position to add the modules you want and to put the
bot in the channels you want it in.
To load modules is easy.
/msg mozbot load module
...where "module" is a module name, such as "HelloWorld" (note that
the ".bm" extension is not included). By default, the General,
Greeting, Infobot and Parrot modules are loaded. The General module
provides the 'help' command and responds to CTCP VERSION messages. The
Greeting module responds to greetings and generally tries to be
friendly. The Infobot module provides information storage and
retrieval functions. The Parrot module lets an admin control the bot
much like a puppet.
By default, modules will be enabled in all channels. See the
"variables" section below to change this.
HINTS
-----
If the bot goes mad and starts flooding a channel -- e.g., if someone
keeps asking it for information -- then authenticate and then send it
the following message:
/msg mozbot shutup please
It should respond within a few seconds. You can authenticate while it
is speaking, that's not a problem.
VARIABLES
---------
For information on changing variables on the fly, use the "vars"
command:
/msg mozbot vars
Each module has several variables that you can change. You can see
what they are by typing:
/msg mozbot vars module
...where module is the module in question. These always include
"Admin" and "General". Admin provides the commands such as "auth",
"newuser", "password", and provides additional commands to admins,
such as "shutdown", "cycle", "leave", "restart", and so on. "General"
provides the "help" command to everyone.
The main variables are:
channels -- which channels the module should listen in, and which
channels the module should send announcements to. Must be in
lowercase!
channelKeys -- a mapping of (lowercase) channel names to keys. It
is assumed that any channel without an entry in this variable has
no key. For example, to tell mozbot that the key for channel
#channel is 'password', you would use:
/msg mozbot vars Admin channelKeys '+|#channel|password'
autojoin -- whether (1) or not (0) the module should automatically
add a new channel to its "channels" list when the bot joins a new
channel. If this is not enabled, then you will have to add new
channels to the "channels" list of this module each time.
channelsBlocked -- channels that will not be autojoined, so if a
module has been disabled, it won't rejoin the channel if the bot is
kicked then reinvited.
denyusers -- user@host regexp masks of users that should be
completely ignored (for this module). The regexp will be placed
between "^" and "$" modifiers, so do not include them, and *do*
include everything required to make the whole user@host mask match.
allowusers -- identical in usage to denyusers, but checked first to
override it. So to give access to everyone but a few people, leave
allowusers blank and add some masks to denyusers, but to give
access to only a few people, add their user@host masks to
allowusers, and add ".*" to denyusers.
In addition, other modules may have extra variables.
The admin variable has quite a few variables, including all those that
are prompted for during initial startup. The interesting ones are:
currentnick -- the nick. This can be changed on the fly.
server, port, password -- the server and port to connect to, and
the server password to use. If you change these and then cycle the
bot (/msg mozbot cycle) then the bot will change servers without
shutting down.
localAddr -- if you don't seem to be able to establish a
connection, but it works fine with other software, then you should
try setting the localAddr variable to your IP address. Technically,
this variable sets which interface to use to form the outgoing
connection. (This is to work around a limitation of Net::IRC.)
Typically you would set this variable directly in the configuration
file, by adding a line that says "localAddr=10.11.12.13" or
whatever your IP address is.
simpleIRCNameServer -- if the value of this variable equals the
name of the server, then the IRC Name sent to the server will be
simplified so that it doesn't include the URI of the mozbot help
files. This is usually dealt with automatically, but if you are
having troubles connecting, you could try setting it. (It is set to
the name of the server so that if you change servers, by default
mozbot will use a complete IRC Name again.)
username -- if this variable has a true value, then the bot will
use its value as its IRC username. By default, the bot uses
"pid-1234" as the username, where "1234" is the bot's process ID.
This can cause problems on networks or with BNCs that require a
valid and accurate ident, in which case this variable can provide a
solution. (You can also set this variable by entering
"username=blah" into the configuration file, where blah is the
username you want to use.)
channels -- unlike other modules, the channels variable for the
Admin module actually controls which channels the bot itself
appears in. The preferred method for controlling this is using
/invite and /kick or "join" and "part", though (since editing the
list directly will probably require a cycle of the bot to take
effect).
admins -- the administrators. See "Administration" above.
allowInviting -- this controls whether the /invite IRC command will
be obeyed or not.
allowChannelAdmin -- this controls whether or not the bot will
accept admin commands that are given in a channel or not. In any
case, the "auth" command is never accepted in a channel.
files -- this is a list of files whose timestamps are monitored to
decide if the source code has changed. If it is established that
any of these files have changed while the bot is running, then the
bot will shutdown and restart itself. Modules are dealt with
separately, and need not be listed here. (And when modules change,
the whole bot is not restarted, only the module.)
sourceCodeCheckDelay -- number of seconds between checks of the bot
and module sources. Note that changes will only take effect after
the previous timer has passed, so changing it from 3600 (an hour)
to 10 (10 seconds) may not be of much immediate use. In these
cases, setting the variable to the new value then cycling the bot
is a good plan.
ignoredUsers -- a list of regular expressions that are matched
against the user@host strings of everything that is said. If a user
matches one of the entires in this list, then that user will be
completely ignored. (^ and $ symbols are implied at the start and
end of this regular expression.) Use this sparingly. It will stop
the user's statements from having _any_ effect on the bot,
including in any statistic-collecting modules, etc. If you just
want to block a user from certain modules, add a regular expression
to the 'denyusers' variable of those modules.
Example:
>mozbot< vars Admin ignoredUsers '+root@.*'
*** moron (root@example.org) has joined #mozbot
<moron> mozbot: help
* you watch the tumbleweed roll on by
ignoredTargets -- when someone says something to someone who
matches one of the regular expressions in this list, the line will
be ignored as if the person saying it was banned with ignoreUsers.
This is useful when you have other bots in the channel, and don't
want the mozbot to respond in place of the other bots (e.g. with an
auto-helping Infobot module). Note: It is safe to user a regular
expression that matches the mozbot bot's name; it will always
respond to messages to itself (as well as messages that are sent
via /msg) irrespective of this setting.
Example:
<user> foobot: what is green?
<foobot> user: green is good.
<mozbot> user: green is good.
<user> mozbot: vars Admin ignoredTargets '+.*bot[0-9]*'
<mozbot> Variable 'ignoredTargets' in module 'Admin' has changed.
<user> foobot: what is green?
<foobot> user: green is good.
* user patpats mozbot
Changes to variables are usually immediately recorded in the
configuration file and will be saved for the next time the bot is
loaded.
There are three types of editable variables: scalars, arrays of
scalars, and hashes of scalars.
Scalars are easy, and lists are explained by the bot quite well, just
try to set a list and it will tell you if you are doing something
wrong!
To add a value to a hash, there is a more complex syntax. For example,
to add a new site to the list of sites that the RDF module monitors,
use the following command:
/msg mozbot vars RDF sites '+|slashdot|http://slashdot.org/slashdot.rdf'
First, note that the value is surrounded by quotes. You can nest
quotes without any problems, the quotes are just needed to
differentiate significant trailing whitespace from mistakes.
The "+" means you want to add a value to the hash (as you'll see in a
minute, to remove an item you use "-"). Then, since a hash is a
key/value pair, you have to delimit the two. In this case, we have
used "|" as a delimiter. However, you could use anything. The first
occurance tells mozbot what delimiter you have picked. The second
separates the key (in this case the site nickname) from the value (in
this case the URI). For example:
/msg mozbot vars RDF sites '+*key*value'
You could even use a letter as a delimiter, but since that is usually
a sign that you have forgotten to declare which delimiter you are
using, mozbot will warn you about this. For example (the 'users' hash,
BTW, is the hash in which all the username/password pairs are kept):
/msg mozbot vars Admin users '+sarah|lisa'
...will be treated the same as:
/msg mozbot vars Admin users '+*arah|li*a'
..., i.e. the username added would be "arah|li" and the password would
be "a". This is not a bug, it's a feature. It means you can include
any character, including "'", "|", and so on, in the key, without fear
of it being interpreted as a delimiter.
To remove a user, or any key/value pair in a hash, you use this
syntax:
/msg mozbot vars Admin users '-admin'
That's it. No need to say what the value is, since each key in a hash
has to be unique. (Although, in this particular case, it should be
noted that the preferred way to remove users is actually the
'deleteuser' command.)
-- end --

View File

@@ -1,514 +0,0 @@
_ _
m o z i l l a |.| o r g | |
_ __ ___ ___ ___| |__ ___ | |_
| '_ ` _ \ / _ \_ / '_ \ / _ \| __|
| | | | | | (_) / /| |_) | (_) | |_
|_| |_| |_|\___/___|_.__/ \___/ \__|
====================================
INTRODUCTION
------------
This was written as a living document. I (the author of mozbot 2.0)
tried (successfully!) to set up mozbot in a secure environment,
chrooted and setuided. This requires much more than a usual
installation. So, without further ado, over to myself in the field:
GETTING STARTED
---------------
I will first be trying to install mozbot 2.0 on a SPARC machine
running Sun Solaris. These instructions will probably work for any
sane UNIX system. If you use Windows, see the INSTALL.WIN32 file.
<ianh:~> mkdir mozbot
<ianh:~> cd mozbot
<ianh:~/mozbot> version
Machine hardware: sun4u
OS version: 5.7
Processor type: sparc
Hardware: SUNW,Ultra-60
I already had Emacs 20.7 installed on the machine, for which I must
thank Pavlov. You may, of course, use any editor of your choosing when
doing this, although if you use vi or one of its siblings then don't
even _think_ about asking me for help. (If you can understand vi I
figure mozbot should no problem.)
<ianh:~> mkdir mozbot
<ianh:~> cd mozbot
I also had several gigabytes of free disk space. You'll probably need
several hundred megabytes to do all of this (including scratch space).
(I believe the end result was around 30 megs for everything in the
chroot jail directory.)
PERL
----
The first thing on my list was to install Perl.
<ianh:~/mozbot> mkdir resources
<ianh:~/mozbot> cd resources
<ianh:~/mozbot/resources> wget http://www.perl.com/CPAN/src/stable.tar.gz
<ianh:~/mozbot/resources> tar xvfz stable.tar.gz
Next I read the README and INSTALL files:
<ianh:~/mozbot/resources> cd perl-5.6.0/
<ianh:~/mozbot/resources/perl-5.6.0> emacs-20.7 README INSTALL
This told me how to do the next few bits.
<ianh:~/mozbot/resources/perl-5.6.0> rm -f config.sh Policy.sh
<ianh:~/mozbot/resources/perl-5.6.0> sh Configure -Dprefix=/u/ianh/mozbot
By providing a prefix, the default installation directory for a lot of
modules I am about to install is automatically set up correctly. So if
you don't install Perl yourself, remember to take this into account!
Note: I didn't change any of the build options, so threads, debugging
and the like are all disabled (or at their defaults). The only things
I changed were that I answered 'n' to the question 'Binary
compatibility with Perl 5.005?', which defaulted to 'y', and I told it
not to install into '/usr/bin/perl'.
<ianh:~/mozbot/resources/perl-5.6.0> make
<ianh:~/mozbot/resources/perl-5.6.0> make test
<ianh:~/mozbot/resources/perl-5.6.0> make install
<ianh:~/mozbot/resources/perl-5.6.0> cd ..
At this point I had Perl installed correctly in my mozbot directory.
WGET
----
The next thing to install was wget.
<ianh:~/mozbot/resources> wget ftp://ftp.gnu.org/pub/gnu/wget/wget-1.6.tar.gz
<ianh:~/mozbot/resources> tar xvfz wget-1.6.tar.gz
<ianh:~/mozbot/resources> cd wget-1.6
<ianh:~/mozbot/resources/wget-1.6> emacs-20.7 README INSTALL
<ianh:~/mozbot/resources/wget-1.6> ./configure --prefix=/u/ianh/mozbot
<ianh:~/mozbot/resources/wget-1.6> make
<ianh:~/mozbot/resources/wget-1.6> make install
<ianh:~/mozbot/resources/wget-1.6> cd ..
No problems, no difficulties.
MOZBOT
------
Now, before going on any further with installing the required modules,
I needed to find what those were. Ergo, the next thing to install was
mozbot. Presumably you already have the relevant files, or know where
to get them, since you are reading a file that comes with the source.
<ianh:~/mozbot/resources> wget http://www.damowmow.com/mozilla/mozbot/mozbot.tar.gz
There is no configuration, makefile or install script for mozbot,
since there is nothing to compile or particularly install. So, I just
extracted the mozbot tarball directly inside what would be the root of
the file system when I eventually chroot()ed.
<ianh:~/mozbot/resources> cd ../..
<ianh:~> tar xvfz mozbot/resources/mozbot.tar.gz
Like all shell scripts, one thing to change about it is the location
of the Perl executable in the shebang.
<ianh:~> cd mozbot
<ianh:~/mozbot> emacs-20.7 mozbot.pl
Since I'll be running it from the version of Perl I just installed, I
changed the first line to read:
#!./bin/perl -wT
Note that this requires me to run mozbot from the mozbot directory. If
you've read the README file, you'll know that this is a prerequisite
of running mozbot anyway.
Net::IRC
--------
If you tried running mozbot now, you'd find it was missing
Net::IRC. So, guess what I installed next? ;-)
<ianh:~/mozbot> cd resources
<ianh:~/mozbot/resources> wget http://www.cpan.org/authors/id/FIMM/Net-IRC-0.70.tar.gz
<ianh:~/mozbot/resources> tar xvfz Net-IRC-0.70.tar.gz
<ianh:~/mozbot/resources> cd Net-IRC-0.70
<ianh:~/mozbot/resources/Net-IRC-0.70> emacs-20.7 README
<ianh:~/mozbot/resources/Net-IRC-0.70> ../../bin/perl Makefile.PL
<ianh:~/mozbot/resources/Net-IRC-0.70> make
<ianh:~/mozbot/resources/Net-IRC-0.70> make install
<ianh:~/mozbot/resources/Net-IRC-0.70> cd ..
It is important to use the Perl we just installed and not any other
Perl on the system, otherwise you'll get incorrect prefixes and
stuff. (I didn't bother to use the wget I just installed...)
Net::SMTP
---------
Yup, you guessed it, Net::SMTP is next.
<ianh:~/mozbot/resources> wget http://www.cpan.org/authors/id/GBARR/libnet-1.0703.tar.gz
<ianh:~/mozbot/resources> tar xvfz libnet-1.0703.tar.gz
<ianh:~/mozbot/resources> cd libnet-1.0703
<ianh:~/mozbot/resources/libnet-1.0703> emacs-20.7 README
<ianh:~/mozbot/resources/libnet-1.0703> ../../bin/perl Makefile.PL
I answered 'y' to the question 'Do you want to modify/update your
configuration (y|n) ? [no]', which was asked because the system
had already had libnet installed once.
I kept the defaults for all the options though.
<ianh:~/mozbot/resources/libnet-1.0703> make
<ianh:~/mozbot/resources/libnet-1.0703> make test
<ianh:~/mozbot/resources/libnet-1.0703> make install
<ianh:~/mozbot/resources/libnet-1.0703> cd ..
This also installed Net::FTP, which is required by some of the modules
(in particular, the FTP module!).
INITIAL CONFIGURATION
---------------------
Now I needed to set up the environment for mozbot. The only real thing
that needs setting up is the PATH variable. So:
<ianh:~/mozbot/resources> cd ..
<ianh:~/mozbot> emacs-20.7 run-mozbot-chrooted
Here are the contents of my run-mozbot-chrooted script:
export PATH=/u/ianh/mozbot/bin
./mozbot.pl
It is absolutely imperative that the path not contain '::' or '.'
anywhere, as this will be treated as the current directory, which will
then result in perl exiting with taint errors.
Now we make it executable:
<ianh:~/mozbot> chmod +x run-mozbot-chrooted
(Note. a sample run-mozbot-chrooted script is shipped with mozbot --
it still requires you to follow all these steps though.)
INITIAL RUN
-----------
At this point, mozbot is runnable... so I ran it!
<ianh:~/mozbot> ./run-mozbot-chrooted
Note that I'm running it via my script and not directly. If you were
not intending to run mozbot in a chroot() jail environment, then
'./mozbot.pl' would be sufficient.
It prompted me for various things, like servers and so on. Then it
connected without problems but with no modules set up, as I expected.
On IRC, I configured mozbot as I wanted it:
/query mozbot
mozbot auth admin password
newuser Hixie newpass newpass
bless Hixie
auth Hixie newpass
I also played a bit with the configuration variables:
vars Admin throttleTime '2.2'
This was all very well, but no modules makes mozbot a boring bot, so
the next thing was...
FILTERS
-------
I shut down mozbot ('shutdown please') and installed the filters
required by the 'Filters' BotModule.
<ianh:~/mozbot> cd resources
<ianh:~/mozbot/resources> wget ftp://ftp.debian.org/pub/mirrors/debian/dists/potato/main/source/games/filters_2.9.tar.gz
<ianh:~/mozbot/resources> tar xvfz filters_2.9.tar.gz
<ianh:~/mozbot/resources> cd filters
<ianh:~/mozbot/resources/filters> emacs-20.7 README
<ianh:~/mozbot/resources/filters> make
At this point, I edited the Makefile to change /usr/.../ so as to
point in the places we used for installing Perl.
<ianh:~/mozbot/resources/filters> make install PREFIX=/u/ianh/mozbot
<ianh:~/mozbot/resources/filters> cd ..
I should point out that this didn't go too well and I had to hack
about with the Makefile and my environment and so on, so good luck
(admittedly, Pavlov happened to install a new compiler at the same
time, and didn't bother to install a license for it, so I had a few
more problems than you should, but...).
You should also make sure that the shebang lines in the five relevant
perl scripts that you should make sure ended up in ~/mozbot/bin
actually point to the right perl executable. I had to edit the files
by hand.
Net::Telnet
-----------
In order to insult people, the Rude module needs to Telnet:
<ianh:~/mozbot/resources> wget http://www.cpan.org/authors/id/JROGERS/Net-Telnet-3.02.tar.gz
<ianh:~/mozbot/resources> tar xvfz Net-Telnet-3.02.tar.gz
<ianh:~/mozbot/resources> cd Net-Telnet-3.02
<ianh:~/mozbot/resources/Net-Telnet-3.02> emacs-20.7 README
<ianh:~/mozbot/resources/Net-Telnet-3.02> ../../bin/perl Makefile.PL
<ianh:~/mozbot/resources/Net-Telnet-3.02> make
<ianh:~/mozbot/resources/Net-Telnet-3.02> make test
<ianh:~/mozbot/resources/Net-Telnet-3.02> make install
<ianh:~/mozbot/resources/Net-Telnet-3.02> cd ..
That went a lot smoother than the filters installation, let me tell
you! ;-)
WWW::Babelfish
--------------
The translation module requires a whole bunch of other modules, mainly
due to its dependency on WWW::Babelfish, which requires half of libwww
and also IO::String. libwww itself requires another half a dozen
modules, namely URI, MIME-Base64, HTML::Parser, libnet (which I
installed earlier, thankfully), and Digest::MD5. And HTML-Parser
requires HTML-Tagset!
I found these dependencies out by browsing CPAN reading README files.
<ianh:~/mozbot/resources> lynx http://www.cpan.org/
Thankfully, they all installed rather smoothly. Here is the complete
list of commands I used to install WWW::Babelfish (starting in the
'resources' directory):
wget http://www.cpan.org/authors/id/GAAS/MIME-Base64-2.12.tar.gz
tar xvfz MIME-Base64-2.12.tar.gz
cd MIME-Base64-2.12
../../bin/perl Makefile.PL
make
make test
make install
cd ..
wget http://www.cpan.org/authors/id/GAAS/URI-1.11.tar.gz
tar xvfz URI-1.11.tar.gz
cd URI-1.11
../../bin/perl Makefile.PL
make
make test
make install
cd ..
wget http://www.cpan.org/authors/id/S/SB/SBURKE/HTML-Tagset-3.03.tar.gz
tar xvfz HTML-Tagset-3.03.tar.gz
cd HTML-Tagset-3.03
../../bin/perl Makefile.PL
make
make test
make install
cd ..
wget http://www.cpan.org/authors/id/GAAS/HTML-Parser-3.19_91.tar.gz
tar xvfz HTML-Parser-3.19_91.tar.gz
cd HTML-Parser-3.1991
../../bin/perl Makefile.PL
make
make test
make install
cd ..
wget http://www.cpan.org/authors/id/GAAS/Digest-MD5-2.13.tar.gz
tar xvfz Digest-MD5-2.13.tar.gz
cd Digest-MD5-2.13
../../bin/perl Makefile.PL
make
make test
make install
cd ..
wget http://www.cpan.org/authors/id/GAAS/libwww-perl-5.51.tar.gz
tar xvfz libwww-perl-5.51.tar.gz
cd libwww-perl-5.51
../../bin/perl Makefile.PL
make
make test
make install
cd ..
wget http://www.cpan.org/authors/id/GAAS/IO-String-1.01.tar.gz
tar xvfz IO-String-1.01.tar.gz
cd IO-String-1.01
../../bin/perl Makefile.PL
make
make test
make install
cd ..
wget http://www.cpan.org/authors/id/D/DU/DURIST/WWW-Babelfish-0.09.tar.gz
tar xvfz WWW-Babelfish-0.09.tar.gz
cd WWW-Babelfish-0.09/
../../bin/perl Makefile.PL
make
make test
make install
cd ..
Yes, this is surreal. I always knew languages were hard.
UUIDGEN
-------
The last module, the UUID generator, requires a program that you'll
find along with mozbot in CVS. You may have this already. If you
don't, then here's how I got my copy:
<ianh:~/mozbot/resources> export CVSROOT=:pserver:anonymous@cvs-mirror.mozilla.org:/cvsroot
<ianh:~/mozbot/resources> cvs login
The password is 'anonymous'.
<ianh:~/mozbot/resources> cvs checkout mozilla/webtools/mozbot/uuidgen
<ianh:~/mozbot/resources> cd mozilla/webtools/mozbot/uuidgen/
<ianh:~/mozbot/resources/mozilla/webtools/mozbot/uuidgen> make
<ianh:~/mozbot/resources/mozilla/webtools/mozbot/uuidgen> cp uuidgen ../../../../../bin
<ianh:~/mozbot/resources/mozilla/webtools/mozbot/uuidgen> cd ../../../../../
At this point I think I had all the required programs.
MORE THOROUGH CONFIGURATION
---------------------------
Now that I'm ready to run mozbot chroot()ed, it is time to make the
final preparations. Firts, I moved the resources directory out of the
way, since I had finished with it:
<ianh:~/mozbot> mv resources ../installed-resources
Next I made sure all the rights were set to read-only for people other
than the user:
<ianh:~/mozbot> chmod -R go-w .
At this point I wanted to make sure the bot started ok, so I ran the
run-mozbot-chrooted script:
<ianh:~/mozbot> ./run-mozbot-chrooted
That worked. I changed the script to:
export PATH=/bin
./mozbot.pl --chroot /config/default
What's this 'config' thing? Well, since we're about to chown() all the
files to root and then setuid the script to nobody, the bot wouldn't
be able to edit the config file if it was in the same directory as the
source -- so I created a new directory with no rights restrictions,
and moved the configuration file into it:
<ianh:~/mozbot> mkdir config
<ianh:~/mozbot> mv mozbot.pl.cfg config/default
<ianh:~/mozbot> chmod ugo=rwx config
<ianh:~/mozbot> chmod ugo=rw config/default
In order to not have to change all the perl scripts, I gave them a
fake 'mozbot' directory:
<ianh:~/mozbot> mkdir u
<ianh:~/mozbot> mkdir u/ianh
<ianh:~/mozbot> cd u/ianh
<ianh:~/mozbot/u/ianh> ln -s / mozbot
<ianh:~/mozbot/u/ianh> cd ../../
At this point I ran 'su' to drop down to a root shell. Be careful!
I had to copy several library files to a usr/lib directory. To do
this, the 'truss' and 'ldd' tools came in very useful. In particular,
I used 'truss' to watch what calls mozbot was attempting, and 'ldd' to
find what modules dependencies Perl, wget, and the modules had.
Credit should be given to Pavlov for actually doing most of this for
me... I didn't even know 'ldd' existed until he showed me. ;-)
Here is the list of the modules I copied:
usr/lib:
ld.so.1 libdl.so.1 libgen.so.1 libmp.so.2
libresolv.so.1 libsec.so.1 nscd_nischeck nss_files.so.1
libc.so.1 libdoor.so.1 libld.so.2 libnsl.so.1
libresolv.so.2 libsocket.so.1 nss_compat.so.1 nss_nis.so.1
libcrypt_i.so.1 libelf.so.1 liblddbg.so.4 libpthread.so.1
librtld.so.1 libthread.so.1 nss_dns.so.1 nss_nisplus.so.1
usr/platform/SUNW,Ultra-60:
libc_psr.so.1
You may not need all of these.
I also had to copy /dev/null, /dev/zero, /dev/tcp, /dev/ticotsord and
/dev/udp into a new dev/ directory (hint: use 'tar' to copy devices,
it won't work if you try to do it with 'cp'). I may not have needed
all of these (this was slightly complicated by the fact that on
Solaris the /dev devices are symlinks; I used 'tar' to copy the real
devices from /devices and renamed them when I extracted the tarball):
total 4
drwxrwxr-x 2 root other 512 Mar 30 14:34 .
drwxr-xr-x 16 root staff 512 Mar 30 15:47 ..
crw-rw-r-- 1 root sys 13, 2 Mar 30 14:25 null
crw-rw-rw- 1 root sys 11, 42 Jun 6 2000 tcp
crw-rw-rw- 1 root sys 105, 1 Jun 6 2000 ticotsord
crw-rw-rw- 1 root sys 11, 41 Jun 6 2000 udp
crw-rw-r-- 1 root sys 13, 12 Jun 6 2000 zero
I had to copy several files from /etc into a new 'etc' directory, in
particular:
etc:
group hosts netconfig nsswitch.conf
passwd protocols resolv.conf wgetrc
You may wish to sanitize your 'passwd' file. For the nsswitch.conf
file you should use the 'nsswitch.dns' file (if you have one) -- make
sure the DNS line is 'dns files' and not 'files dns'. (Profuse thanks
go to rfm from Sun who helped me with this.)
Now I used 'chown' to make every file in /u/ianh/mozbot/ be owned by
root, except the config directory. I also edited 'mozbot.pl' to ensure
that the correct arguments were passed to 'setuid' and 'setgid' --
search for 'setuid' in the source to find the right place.
With that all set up, I finally could run the bot safe in the
knowledge that it was relatively secure:
<root:/u/ianh/mozbot> ./run-mozbot-chrooted
I hope this has helped you in some way!!!
-- end --

View File

@@ -1,29 +0,0 @@
_ _
m o z i l l a |.| o r g | |
_ __ ___ ___ ___| |__ ___ | |_
| '_ ` _ \ / _ \_ / '_ \ / _ \| __|
| | | | | | (_) / /| |_) | (_) | |_
|_| |_| |_|\___/___|_.__/ \___/ \__|
====================================
INTRODUCTION
------------
Running mozbot on windows is officially unsupported, and does not
work at all when using ActiveState Perl, as it does not support
forking which mozbot uses extensively.
However, mozbot runs successfully on Windows with Cygwin Perl. Tested
on Microsoft Windows XP and Windows Server 2003, Perl 5.8.4 and higher,
including 5.10. Windows Vista and Windows Server 2008 may also work, but
have not been tested, you're on your own.
Once you have Cygwin (http://www.cygwin.com) installed with the Perl
package, follow the instructions in the INSTALL file. You will need
to use CPAN and install the required modules for mozbot to work
properly.
Your mileage may vary, it may not work at all for you. Good luck.
-- end --

View File

@@ -1,4 +0,0 @@
This is the source code for "mozbot", the IRC bot who hangs out in the
#mozilla channel at irc.mozilla.org.
See the INSTALL file for installation and configuration instructions.

View File

@@ -1,130 +0,0 @@
connectTimeout=120
helpline=see http://www.mozilla.org/projects/mozbot/
sleep=60
throttleTime=2.2
Admin::files=lib/Configuration.pm
Admin::files=lib/Mails.pm
Admin::files=mozbot.pl
Admin::files=lib/IO/SecurePipe.pm
Bugzilla::ignoreCommentsFrom=|
FortuneCookies::bakingTime=20
FortuneCookies::cookies=* UNIX is a Trademark of Bell Laboratories.
FortuneCookies::cookies=/earth is 98% full ... please delete anyone you can.
FortuneCookies::cookies=A man is not complete until he is married -- then he is finished.
FortuneCookies::cookies=A man with his hands in pockets feels foolish, but a man with holes in pockets feels nuts.
FortuneCookies::cookies=A meeting is an event at which the minutes are kept and the hours are lost.
FortuneCookies::cookies=A modem is a baudy house.
FortuneCookies::cookies=A thunderstorm in .nl here can startle a butterfly in .au
FortuneCookies::cookies=Anyone can make an omelet with eggs. The trick is to make one with none.
FortuneCookies::cookies=Best of all is never to have been born. Second best is to die soon.
FortuneCookies::cookies=Better to sleep with chicken than to choke it.
FortuneCookies::cookies=Confession is good for the soul, but bad for the career.
FortuneCookies::cookies=Confucius not: know what to say!
FortuneCookies::cookies=Confucius say: "Is more to running BBS than finding ON.
FortuneCookies::cookies=Confucius say: A bird in hand makes hard to blow nose.
FortuneCookies::cookies=Confucius say: Baby conceived in automatic car shiftless bastard.
FortuneCookies::cookies=Confucius say: I didn't say that!
FortuneCookies::cookies=Confucius say: Is stuffy inside fortune cookie.
FortuneCookies::cookies=Confucius say: Man who Farts in Church sits in own pew.
FortuneCookies::cookies=Confucius say: Man who pull out too fast leave rubber.
FortuneCookies::cookies=Confucius say: Man who stand on toilet is high on pot.
FortuneCookies::cookies=Confucius say: Man with hand in pocket is having a ball.
FortuneCookies::cookies=Confucius say: Man with no legs bums around.
FortuneCookies::cookies=Confucius say: Put Rooster in Freezer Get A Stiff Cock.
FortuneCookies::cookies=Confucius say: Shit happens.
FortuneCookies::cookies=Confucius say: Show off always shown up in showdown.
FortuneCookies::cookies=Confucius say: Woman who cook carrots and peas in same pot not sanitary!
FortuneCookies::cookies=Confucius say: `A Watched Tandy Never Boots!
FortuneCookies::cookies=Confucius say: man who smoke pot choke on handle.
FortuneCookies::cookies=Confucius say: nothing - Because he's dead!
FortuneCookies::cookies=Confucius say: too damn much!
FortuneCookies::cookies=Death is nature's way of telling you to slow down.
FortuneCookies::cookies=Debug is human, de-fix divine.
FortuneCookies::cookies=Despite all appearances, your boss is a thinking, feeling, human being.
FortuneCookies::cookies=Do not drink coffee in early A.M. It will keep you awake until noon.
FortuneCookies::cookies=Do not simplify the design of a program if a way can be found to make it complex and wonderful.
FortuneCookies::cookies=Due to lack of disk space, this fortune database has been discontinued.
FortuneCookies::cookies=Early to bed and early to rise and you'll be groggy when everyone else is wide awake.
FortuneCookies::cookies=Every path has its puddle.
FortuneCookies::cookies=Everything that you know is wrong, but you can be straightened out.
FortuneCookies::cookies=Experience is the worst teacher. It always gives the test first and the instruction afterward.
FortuneCookies::cookies=Future looks spotty. You will spill soup in late evening.
FortuneCookies::cookies=God made machine language; all the rest is the work of man.
FortuneCookies::cookies=He that teaches himself has a fool for a master.
FortuneCookies::cookies=He who crosses the ocean twice without washing is a dirty double crosser.
FortuneCookies::cookies=He who has a shady past knows that nice guys finish last.
FortuneCookies::cookies=History repeats itself. That's one thing wrong with history.
FortuneCookies::cookies=Hope that the day after you die is a nice day.
FortuneCookies::cookies=House without toilet is uncanny.
FortuneCookies::cookies=I have a theory that it's impossible to prove anything, but I can't prove it.
FortuneCookies::cookies=I know you're in search of yourself, I just haven't seen you anywhere.
FortuneCookies::cookies=If at first you don't succeed, redefine success.
FortuneCookies::cookies=If life isn't what you wanted, have you asked for anything else?
FortuneCookies::cookies=If this fortune didn't exist, somebody would have invented it.
FortuneCookies::cookies=If we meet a man of rare intellect, we should ask him what book he reads.
FortuneCookies::cookies=If you are too busy to read, then you are too busy.
FortuneCookies::cookies=If you do something right once, someone will ask you to do it again.
FortuneCookies::cookies=If you park, don't drink, accidents cause people.
FortuneCookies::cookies=If your aim in life is nothing, you can't miss.
FortuneCookies::cookies=In English, every word can be verbed. Would that it were so in our programming languages.
FortuneCookies::cookies=In an orderly world, there's always a place for the disorderly.
FortuneCookies::cookies=In the force if Yoda's so strong, construct a sentence with words in the proper order then why can't he?
FortuneCookies::cookies=It is not well to be thought of as one who meekly submits to insolence and intimidation.
FortuneCookies::cookies=It is very difficult to prophesy, especially when it pertains to the future.
FortuneCookies::cookies=Life is too short to be taken seriously.
FortuneCookies::cookies=Logic is a systematic method of coming to the wrong conclusion with confidence.
FortuneCookies::cookies=Ma Bell is a mean mother!
FortuneCookies::cookies=Man who arrives at party two hours late will find he has been beaten to the punch.
FortuneCookies::cookies=Man who eat many prunes, sit on toilet many moons.
FortuneCookies::cookies=Man who fight with wife all day, get no peace at night!
FortuneCookies::cookies=Man who put head on Rail Road track to listen for train likely to end up with sudden splitting headache.
FortuneCookies::cookies=May all your PUSHes be POPped.
FortuneCookies::cookies=Measure with a micrometer. Mark with chalk. Cut with an axe.
FortuneCookies::cookies=Message will arrive in the mail. Destroy, before the FBI sees it.
FortuneCookies::cookies=Never trust a computer you can't repair yourself.
FortuneCookies::cookies=Never underestimate the power of human stupidity.
FortuneCookies::cookies=No matter what happens, there is always someone who knew it would.
FortuneCookies::cookies=Nondeterminism means never having to say you are wrong.
FortuneCookies::cookies=On the eighth day, God created FORTRAN.
FortuneCookies::cookies=One person's error is another person's data.
FortuneCookies::cookies=One possible reason that things aren't going according to plan is that there never was a plan in the first place.
FortuneCookies::cookies=One seldom sees a monument to a committee.
FortuneCookies::cookies=Others can stop you temporarily, only you can do it permanently.
FortuneCookies::cookies=Overflow on /dev/null, please empty the bit bucket.
FortuneCookies::cookies=Passwords are implemented as a result of insecurity.
FortuneCookies::cookies=Pause for storage relocation.
FortuneCookies::cookies=Pretend to spank me -- I'm a pseudo-masochist!
FortuneCookies::cookies=Quantity is no substitute for quality, but its the only one we've got.
FortuneCookies::cookies=Real computer scientists don't comment their code. The identifiers are so long they can't afford the disk space.
FortuneCookies::cookies=Recursion is the root of computation since it trades description for time.
FortuneCookies::cookies=Standards are crucial. And the best thing about standards is: there are so many to choose from!
FortuneCookies::cookies=The first version always gets thrown away.
FortuneCookies::cookies=The important thing is not to stop questioning.
FortuneCookies::cookies=The light of a hundred stars does not equal the light of the moon.
FortuneCookies::cookies=The meek shall inherit the earth; the rest of us will go to the stars.
FortuneCookies::cookies=The more you sweat in peace, the less you bleed in war.
FortuneCookies::cookies=The most important early product on the way to developing a good product is an imperfect version.
FortuneCookies::cookies=The number of feet in a yard is directly proportional to the success of the barbecue.
FortuneCookies::cookies=The only person who always got his work done by Friday was Robinson Crusoe.
FortuneCookies::cookies=The sun will rise in the east today, indicating nothing in particular.
FortuneCookies::cookies=The trouble with computers is that they do what you tell them, not what you want.
FortuneCookies::cookies=There are two ways to write error-free programs; only the third one works.
FortuneCookies::cookies=This life is yours. Some of it was given to you; the rest, you made yourself.
FortuneCookies::cookies=This system will self-destruct in five minutes.
FortuneCookies::cookies=This will be a memorable month -- no matter how hard you try to forget it.
FortuneCookies::cookies=Those who do not understand Unix are condemned to reinvent it, poorly.
FortuneCookies::cookies=Those who smile bring light to others
FortuneCookies::cookies=Tomorrow will be cancelled due to lack of interest.
FortuneCookies::cookies=War doesn't determine who's right, war determines who's left.
FortuneCookies::cookies=War is peace. Freedom is slavery. Ketchup is a vegetable.
FortuneCookies::cookies=We promise according to our hopes, and perform according to our fears.
FortuneCookies::cookies=Wife who put husband in doghouse soon find him in cat house.
FortuneCookies::cookies=You can always tell the people that are forging the new frontier. They're the ones with arrows sticking out of their backs.
FortuneCookies::cookies=You have many friends and very few living enemies.
FortuneCookies::cookies=You may attend a party where strange customs prevail.
FortuneCookies::cookies=You might have mail.
FortuneCookies::cookies=You will be advanced socially, without any special effort on your part.
FortuneCookies::cookies=You're currently going through a difficult transition period called "Life."
FortuneCookies::cookies=panic: kernel segmentation violation. core dumped (only kidding)
FortuneCookies::cookiesIndex=38
FortuneCookies::cookiesMax=10

View File

@@ -1,209 +0,0 @@
# -*- Mode: perl; indent-tabs-mode: nil -*-
#
# The contents of this file are subject to the Mozilla Public
# License Version 1.1 (the "License"); you may not use this file
# except in compliance with the License. You may obtain a copy of
# the License at http://www.mozilla.org/MPL/
#
# Software distributed under the License is distributed on an "AS
# IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
# implied. See the License for the specific language governing
# rights and limitations under the License.
#
# The Original Code is the Bugzilla Bug Tracking System.
#
# The Initial Developer of the Original Code is Netscape Communications
# Corporation. Portions created by Netscape are
# Copyright (C) 1998 Netscape Communications Corporation. All
# Rights Reserved.
#
# Contributor(s): Harrison Page <harrison@netscape.com>
# Terry Weissman <terry@mozilla.org>
# Ian Hickson <py8ieh=mozbot@bath.ac.uk>
package Configuration;
use strict;
use Carp;
sub Get {
my ($file, $config) = @_;
my %seen;
open FILE, "<$file" or return 0;
my $line = 0;
while (<FILE>) {
$line++; chomp;
if (/^ *([^#;][^=\n\r]*)(?:=(.*))?$/os) {
my $value = $$config{$1};
if (defined($value)) {
$value = $$value while ref($value) eq 'REF';
if (ref($value) eq 'SCALAR') {
$$value = $2;
} elsif (ref($value) eq 'ARRAY') {
unless ($seen{$1}) {
@$value = ();
}
if (defined($2)) {
push(@$value, $2);
}
} elsif (ref($value) eq 'HASH') {
unless ($seen{$1}) {
%$value = ();
}
if (defined($2)) {
$2 =~ /^(.)(.*?)\1=>(.*)$/so;
$$value{$2} = $3;
}
}
} # else unknown variable, ignore
$seen{$1} = 1;
} # else ignore (probably comment)
}
close FILE;
return $line;
}
sub Save {
my ($file, $config) = @_;
local $_;
# Try to keep file structure if possible
my @lines;
if (open FILE, "<$file") {
while (<FILE>) {
push @lines, $_;
}
close FILE;
}
# but make sure we put in all the data (dups are dealt with)
foreach (sort keys %$config) {
push @lines, "$_=";
}
# Open file to which we are saving
open FILE, ">$file.~$$~" or confess("Could not save configuration: $!");
# ok, save file back again
# make sure we only write parameters once by
# keeping a log of those done
my %seen;
foreach (@lines) {
chomp;
if (/^ *([^#;][^=\n\r]*)(?:=(.*))?$/os) {
my $variable = $1;
my $value = $2;
if (defined($$config{$variable})) {
unless ($seen{$variable}) {
$value = $$config{$variable};
$value = $$value while ref($value) eq 'REF';
if (ref($value) eq 'SCALAR') {
if (defined($$value)) {
print FILE $variable.'='.$$value."\n" or confess("Could not save configuration: $!");
}
} elsif (ref($value) eq 'HASH') {
my @keys = keys %$value;
if (@keys > 0) {
foreach my $item (@keys) {
my $data = $$value{$item};
$item = '' unless defined $item;
$data = '' unless defined $data;
my $delimiter;
foreach ('"','\'','|',':','#','*','<','>','/','[',']','{','}',
'(',')','\\','=','-','@','!','\$','%','&',' ','\`','~') {
if ($item !~ /\Q$_\E=>/os) {
$delimiter = $_;
last;
}
}
if (defined($delimiter)) {
print FILE "$variable=$delimiter$item$delimiter=>$data\n"
or confess("Could not save configuration: $!");
}
# else, silent data loss... XXX
}
} else {
print FILE "$variable\n" or confess("Could not save configuration: $!");
}
} elsif (ref($value) eq 'ARRAY') {
if (@$value > 0) {
foreach my $item (@$value) {
if (defined($item)) {
print FILE "$variable=$item\n" or confess("Could not save configuration: $!");
} else {
print FILE "$variable=\n" or confess("Could not save configuration: $!");
}
}
} else {
print FILE "$variable\n" or confess("Could not save configuration: $!");
}
} else {
confess("Unsupported data type '".ref($value)."' writing $variable (".$$config{$variable}.')');
}
$seen{$variable} = 1;
} # else seen it already
} else { # unknown
if (defined($value)) {
print FILE "$variable=$value\n" or confess("Could not save configuration: $!");
} else {
print FILE "$variable\n" or confess("Could not save configuration: $!");
}
}
} else {
# might be a comment
print FILE $_."\n" or confess("Could not save configuration: $!");
}
}
# actually do make a change to the real file
close FILE or confess("Could not save configuration: $!");
# -- #mozwebtools was here --
# * Hixie is sad as his bot crashes.
# * Hixie adds in a check to make sure that the file he tries
# to delete actually exists first.
# <timeless> delete??
unlink $file or confess("Could not delete $file: $!") if (-e $file);
rename("$file.~$$~", $file) or confess("Could not rename to $file: $!");
}
sub Ensure {
my ($config) = @_;
my $changed;
foreach (@$config) {
if (ref($$_[1]) eq 'SCALAR') {
unless (defined(${$$_[1]})) {
if (-t) {
print $$_[0]. ' ';
<> =~ /^(.*)$/os;
${$$_[1]} = $1;
${$$_[1]} = '' unless defined ${$$_[1]};
chomp(${$$_[1]});
$changed++;
} else {
confess("Terminal is not interactive, so could not ask '$$_[0]'. Gave up");
}
}
} elsif (ref($$_[1]) eq 'ARRAY') {
unless (defined(@{$$_[1]})) {
if (-t) {
print $$_[0]. " (enter a blank line to finish)\n";
my $input;
do {
$input = <>;
$input = '' unless defined $input;
chomp($input);
push @{$$_[1]}, $input if $input;
$changed++;
} while $input;
} else {
confess("Terminal is not interactive, so could not ask '$$_[0]'. Gave up");
}
}
} else {
confess("Unsupported data type expected for question '$$_[0]'");
}
}
return $changed;
}
1; # end

View File

@@ -1,67 +0,0 @@
# IO::SecurePipe.pm
# Created by Ian Hickson to make exec() call if IO::Pipe more secure.
# Distributed under exactly the same licence terms as IO::Pipe.
package IO::SecurePipe;
use strict;
#use Carp;
use IO::Pipe;
use vars qw(@ISA);
@ISA = qw(IO::Pipe);
my $do_spawn = $^O eq 'os2';
sub croak {
$0 =~ m/^(.*)$/os; # untaint $0 so that we can call it below:
exec { $1 } ($1, '--abort'); # do not call shutdown handlers
exit(); # exit (implicit in exec() actually)
}
sub _doit {
my $me = shift;
my $rw = shift;
my $pid = $do_spawn ? 0 : fork();
if($pid) { # Parent
return $pid;
}
elsif(defined $pid) { # Child or spawn
my $fh;
my $io = $rw ? \*STDIN : \*STDOUT;
my ($mode, $save) = $rw ? "r" : "w";
if ($do_spawn) {
require Fcntl;
$save = IO::Handle->new_from_fd($io, $mode);
# Close in child:
fcntl(shift, Fcntl::F_SETFD(), 1) or croak "fcntl: $!";
$fh = $rw ? ${*$me}[0] : ${*$me}[1];
} else {
shift;
$fh = $rw ? $me->reader() : $me->writer(); # close the other end
}
bless $io, "IO::Handle";
$io->fdopen($fh, $mode);
$fh->close;
if ($do_spawn) {
$pid = eval { system 1, @_ }; # 1 == P_NOWAIT
my $err = $!;
$io->fdopen($save, $mode);
$save->close or croak "Cannot close $!";
croak "IO::Pipe: Cannot spawn-NOWAIT: $err" if not $pid or $pid < 0;
return $pid;
} else {
exec { $_[0] } @_ or # XXX change here
croak "IO::Pipe: Cannot exec: $!";
}
}
else {
croak "IO::Pipe: Cannot fork: $!";
}
# NOT Reached
}
1;

View File

@@ -1,196 +0,0 @@
# -*- Mode: perl; indent-tabs-mode: nil -*-
#
# The contents of this file are subject to the Mozilla Public
# License Version 1.1 (the "License"); you may not use this file
# except in compliance with the License. You may obtain a copy of
# the License at http://www.mozilla.org/MPL/
#
# Software distributed under the License is distributed on an "AS
# IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
# implied. See the License for the specific language governing
# rights and limitations under the License.
#
# The Original Code is the Bugzilla Bug Tracking System.
#
# The Initial Developer of the Original Code is Netscape Communications
# Corporation. Portions created by Netscape are
# Copyright (C) 1998 Netscape Communications Corporation. All
# Rights Reserved.
#
# Contributor(s): Harrison Page <harrison@netscape.com>
# Terry Weissman <terry@mozilla.org>
# Ian Hickson <mozbot@hixie.ch>
package Mails;
use strict;
use Carp;
# User must declare the following package global variables:
# $Mails::owner = \'e-mail address of owner';
# $Mails::smtphost = 'name of SMTP server';
# $Mails::debug = \&function to print debug messages # better solutions welcome
# send mail to the owner
sub mailowner {
my ($subject, $text) = @_;
&$Mails::debug('I am going to mail the owner!!!');
return &sendmail($$Mails::owner, $0, $subject, $text);
}
sub RFC822time {
# Returns today's date as an RFC822 compliant string with the
# exception that the year is returned as four digits. In my
# extremely valuable opinion RFC822 was wrong to specify the year
# as two digits. Many email systems generate four-digit years.
# Today is defined as the first parameter, if given, or else the
# value that time() gives.
my ($tsec,$tmin,$thour,$tmday,$tmon,$tyear,$twday,$tyday,$tisdst) = gmtime(shift || time());
$tyear += 1900; # as mentioned above, this is not RFC822 compliant, but is Y2K-safe.
$tsec = "0$tsec" if $tsec < 10;
$tmin = "0$tmin" if $tmin < 10;
$thour = "0$thour" if $thour < 10;
$tmon = ('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun', 'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec')[$tmon];
$twday = ('Sun', 'Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat')[$twday];
return "$twday, $tmday $tmon $tyear $thour:$tmin:$tsec GMT";
}
sub sendmail {
my ($to, $from, $subject, $text, $sig) = (@_, $0);
eval {
use Net::SMTP;
my $date = &RFC822time();
my $smtp = Net::SMTP->new($Mails::smtphost) or confess("Could not create SMTP connection to $Mails::smtphost! Giving Up");
$smtp->mail($ENV{USER}); # XXX ?
$smtp->to($to);
$smtp->data(<<end);
X-Mailer: $0, Mails.pm; $$Mails::owner
To: $to
From: $from
Subject: $subject
Date: $date
$text
--
$sig
end
$smtp->quit;
} or do {
&$Mails::debug('Failed to send e-mail.');
&$Mails::debug($@);
&$Mails::debug('-'x40);
&$Mails::debug("To: $to");
&$Mails::debug("From: $from");
&$Mails::debug("Subject: $subject");
&$Mails::debug("\n$text\n-- \n$sig");
&$Mails::debug('-'x40);
return 0;
};
return 1;
}
##########################################################
#### The Mails ##########################################
##########################################################
sub ServerDown {
my ($server, $port, $localAddr, $nick, $ircname, $username) = @_;
my $localAddrMessage;
if (defined($localAddr)) {
$localAddrMessage = <<end;
You've configured me to assume that '$localAddr' is the address of the
network interface to use. If this is wrong, change the localAddr
setting in the configuration file (or remove it to enable autodetect).
end
} else {
$localAddrMessage = <<end;
I'm currently autodetecting the address of the network interface to
use. If this host has more than one interface, set the localAddr
setting in the configuration file to the IP address of the outgoing
connection I should use.
end
}
return &mailowner("Help! I can't talk to $server:$port!", <<end);
Hello Sir or Madam!
I'm afraid I could not connect to the IRC server. I tried, and will
try and try again (unless you kill me...) but it was fruitless.
Could you kick the IRC server for me? Give it a right ol' booting.
And hit the network connection while you are at it, would you please?
Thanks.
Here is what I was trying to connect to:
Server: $server
Port: $port
Nick: $nick
Ircname: $ircname
Username: $username
$localAddrMessage
Hope that helps.
Cheers,
end
}
sub ServerUp {
my ($server) = @_;
return &mailowner("Woohoo! $server let me in!", <<end);
Hello again.
You'll be happy to know that everything turned out for the better.
Seeya later,
end
}
sub NickShortage {
my ($cfgfile, $hostname, $port, $username, $ircname, @nicks) = @_;
local $" = "\n ";
return &mailowner('There is a nick shortage!', <<end);
Hello Sir or Madam.
I could not find an unused nick on IRC.
I tried all of these:
@nicks
If you like you could add some more nicks manually by
editing my configuration file, "$cfgfile"... *hint* *hint*
Here is what I think I am connected to:
Hostname: $hostname
Port: $port
Username: $username
IRC Name: $ircname
I'll e-mail you again when I manage to get on.
Seeya,
end
}
sub NickOk {
my ($nick) = @_;
return &mailowner("It's ok, I'm now using $nick as my nick.", <<end);
Hello again.
You'll be happy to know that everything turned out for the better.
Seeya later,
end
}
1; # end

File diff suppressed because it is too large Load Diff

View File

@@ -1,5 +0,0 @@
export PATH=/bin
./mozbot.pl --chroot /config/default
# NOTE. This file requires that you follow the steps described in the
# included INSTALL file.

View File

@@ -1,22 +0,0 @@
#!/bin/bash
#
# run-mozbot-from-crontab: Script for restarting mozbot from crontab
# Originally written by Joel Thornton <joelpt@eml.cc>
#
# This is good to use in your crontab for rebooting the bot
# automagically upon its untimely demise. Use a line such as this in
# your crontab:
#
# 0,5,10,15,20,25,30,35,40,45,50,55 * * * * $HOME/mozbot/run-mozbot-from-crontab
#
# Change the paths to your mozbot accordingly above and in the next
# line.
cd $HOME/mozbot
# Create an empty .pid file first if it doesn't exist.
touch ./mozbot.pid
ps -C mozbot.pl -o pid= | grep "`cat ./mozbot.pid`" ||
( ( ./mozbot.pl >& /dev/null & ) ;
ps -C mozbot.pl -o pid= | head --lines=1 > ./mozbot.pid )

View File

@@ -1,17 +0,0 @@
CFLAGS=-g
OBJS=md5.o token.o main.o
all: $(OBJS) uuidgen
uuidgen: $(OBJS)
gcc -o uuidgen $(OBJS)
md5.o: md5.c md5.h
token.o: token.c token.h
main.o: main.c
clean:
rm -f *.o *~ core uuidgen

View File

@@ -1,17 +0,0 @@
/* copyright? hah! it's 10 lines of code! */
#include <stdio.h>
#include "token.h"
int main(int argc, char **argv) {
uuid_state state;
uuid_t uuid;
char output[1024];
create_uuid_state(&state);
create_token(&state, &uuid);
format_token(output, &uuid);
printf("%s\n", output);
}

View File

@@ -1,263 +0,0 @@
/*
* This code implements the MD5 message-digest algorithm.
* The algorithm is due to Ron Rivest. This code was
* written by Colin Plumb in 1993, no copyright is claimed.
* This code is in the public domain; do with it what you wish.
*
* Equivalent code is available from RSA Data Security, Inc.
* This code has been tested against that, and is equivalent,
* except that you don't need to include two pages of legalese
* with every copy.
*
* To compute the message digest of a chunk of bytes, declare an
* MD5Context structure, pass it to MD5Init, call MD5Update as
* needed on buffers full of bytes, and then call MD5Final, which
* will fill a supplied 16-byte array with the digest.
*/
/* Brutally hacked by John Walker back from ANSI C to K&R (no
prototypes) to maintain the tradition that Netfone will compile
with Sun's original "cc". */
#include <memory.h> /* for memcpy() */
#include "md5.h"
#ifdef sgi
#define HIGHFIRST
#endif
#ifdef sun
#define HIGHFIRST
#endif
#ifndef HIGHFIRST
#define byteReverse(buf, len) /* Nothing */
#else
/*
* Note: this code is harmless on little-endian machines.
*/
void byteReverse(buf, longs)
unsigned char *buf; unsigned longs;
{
uint32 t;
do {
t = (uint32) ((unsigned) buf[3] << 8 | buf[2]) << 16 |
((unsigned) buf[1] << 8 | buf[0]);
*(uint32 *) buf = t;
buf += 4;
} while (--longs);
}
#endif
/*
* Start MD5 accumulation. Set bit count to 0 and buffer to mysterious
* initialization constants.
*/
void MD5Init(ctx)
struct MD5Context *ctx;
{
ctx->buf[0] = 0x67452301;
ctx->buf[1] = 0xefcdab89;
ctx->buf[2] = 0x98badcfe;
ctx->buf[3] = 0x10325476;
ctx->bits[0] = 0;
ctx->bits[1] = 0;
}
/*
* Update context to reflect the concatenation of another buffer full
* of bytes.
*/
void MD5Update(ctx, buf, len)
struct MD5Context *ctx; unsigned char *buf; unsigned len;
{
uint32 t;
/* Update bitcount */
t = ctx->bits[0];
if ((ctx->bits[0] = t + ((uint32) len << 3)) < t)
ctx->bits[1]++; /* Carry from low to high */
ctx->bits[1] += len >> 29;
t = (t >> 3) & 0x3f; /* Bytes already in shsInfo->data */
/* Handle any leading odd-sized chunks */
if (t) {
unsigned char *p = (unsigned char *) ctx->in + t;
t = 64 - t;
if (len < t) {
memcpy(p, buf, len);
return;
}
memcpy(p, buf, t);
byteReverse(ctx->in, 16);
MD5Transform(ctx->buf, (uint32 *) ctx->in);
buf += t;
len -= t;
}
/* Process data in 64-byte chunks */
while (len >= 64) {
memcpy(ctx->in, buf, 64);
byteReverse(ctx->in, 16);
MD5Transform(ctx->buf, (uint32 *) ctx->in);
buf += 64;
len -= 64;
}
/* Handle any remaining bytes of data. */
memcpy(ctx->in, buf, len);
}
/*
* Final wrapup - pad to 64-byte boundary with the bit pattern
* 1 0* (64-bit count of bits processed, MSB-first)
*/
void MD5Final(digest, ctx)
unsigned char digest[16]; struct MD5Context *ctx;
{
unsigned count;
unsigned char *p;
/* Compute number of bytes mod 64 */
count = (ctx->bits[0] >> 3) & 0x3F;
/* Set the first char of padding to 0x80. This is safe since there is
always at least one byte free */
p = ctx->in + count;
*p++ = 0x80;
/* Bytes of padding needed to make 64 bytes */
count = 64 - 1 - count;
/* Pad out to 56 mod 64 */
if (count < 8) {
/* Two lots of padding: Pad the first block to 64 bytes */
memset(p, 0, count);
byteReverse(ctx->in, 16);
MD5Transform(ctx->buf, (uint32 *) ctx->in);
/* Now fill the next block with 56 bytes */
memset(ctx->in, 0, 56);
} else {
/* Pad block to 56 bytes */
memset(p, 0, count - 8);
}
byteReverse(ctx->in, 14);
/* Append length in bits and transform */
((uint32 *) ctx->in)[14] = ctx->bits[0];
((uint32 *) ctx->in)[15] = ctx->bits[1];
MD5Transform(ctx->buf, (uint32 *) ctx->in);
byteReverse((unsigned char *) ctx->buf, 4);
memcpy(digest, ctx->buf, 16);
memset(ctx, 0, sizeof(ctx)); /* In case it's sensitive */
}
/* The four core functions - F1 is optimized somewhat */
/* #define F1(x, y, z) (x & y | ~x & z) */
#define F1(x, y, z) (z ^ (x & (y ^ z)))
#define F2(x, y, z) F1(z, x, y)
#define F3(x, y, z) (x ^ y ^ z)
#define F4(x, y, z) (y ^ (x | ~z))
/* This is the central step in the MD5 algorithm. */
#define MD5STEP(f, w, x, y, z, data, s) \
( w += f(x, y, z) + data, w = w<<s | w>>(32-s), w += x )
/*
* The core of the MD5 algorithm, this alters an existing MD5 hash to
* reflect the addition of 16 longwords of new data. MD5Update blocks
* the data and converts bytes into longwords for this routine.
*/
void MD5Transform(buf, in)
uint32 buf[4]; uint32 in[16];
{
register uint32 a, b, c, d;
a = buf[0];
b = buf[1];
c = buf[2];
d = buf[3];
MD5STEP(F1, a, b, c, d, in[0] + 0xd76aa478, 7);
MD5STEP(F1, d, a, b, c, in[1] + 0xe8c7b756, 12);
MD5STEP(F1, c, d, a, b, in[2] + 0x242070db, 17);
MD5STEP(F1, b, c, d, a, in[3] + 0xc1bdceee, 22);
MD5STEP(F1, a, b, c, d, in[4] + 0xf57c0faf, 7);
MD5STEP(F1, d, a, b, c, in[5] + 0x4787c62a, 12);
MD5STEP(F1, c, d, a, b, in[6] + 0xa8304613, 17);
MD5STEP(F1, b, c, d, a, in[7] + 0xfd469501, 22);
MD5STEP(F1, a, b, c, d, in[8] + 0x698098d8, 7);
MD5STEP(F1, d, a, b, c, in[9] + 0x8b44f7af, 12);
MD5STEP(F1, c, d, a, b, in[10] + 0xffff5bb1, 17);
MD5STEP(F1, b, c, d, a, in[11] + 0x895cd7be, 22);
MD5STEP(F1, a, b, c, d, in[12] + 0x6b901122, 7);
MD5STEP(F1, d, a, b, c, in[13] + 0xfd987193, 12);
MD5STEP(F1, c, d, a, b, in[14] + 0xa679438e, 17);
MD5STEP(F1, b, c, d, a, in[15] + 0x49b40821, 22);
MD5STEP(F2, a, b, c, d, in[1] + 0xf61e2562, 5);
MD5STEP(F2, d, a, b, c, in[6] + 0xc040b340, 9);
MD5STEP(F2, c, d, a, b, in[11] + 0x265e5a51, 14);
MD5STEP(F2, b, c, d, a, in[0] + 0xe9b6c7aa, 20);
MD5STEP(F2, a, b, c, d, in[5] + 0xd62f105d, 5);
MD5STEP(F2, d, a, b, c, in[10] + 0x02441453, 9);
MD5STEP(F2, c, d, a, b, in[15] + 0xd8a1e681, 14);
MD5STEP(F2, b, c, d, a, in[4] + 0xe7d3fbc8, 20);
MD5STEP(F2, a, b, c, d, in[9] + 0x21e1cde6, 5);
MD5STEP(F2, d, a, b, c, in[14] + 0xc33707d6, 9);
MD5STEP(F2, c, d, a, b, in[3] + 0xf4d50d87, 14);
MD5STEP(F2, b, c, d, a, in[8] + 0x455a14ed, 20);
MD5STEP(F2, a, b, c, d, in[13] + 0xa9e3e905, 5);
MD5STEP(F2, d, a, b, c, in[2] + 0xfcefa3f8, 9);
MD5STEP(F2, c, d, a, b, in[7] + 0x676f02d9, 14);
MD5STEP(F2, b, c, d, a, in[12] + 0x8d2a4c8a, 20);
MD5STEP(F3, a, b, c, d, in[5] + 0xfffa3942, 4);
MD5STEP(F3, d, a, b, c, in[8] + 0x8771f681, 11);
MD5STEP(F3, c, d, a, b, in[11] + 0x6d9d6122, 16);
MD5STEP(F3, b, c, d, a, in[14] + 0xfde5380c, 23);
MD5STEP(F3, a, b, c, d, in[1] + 0xa4beea44, 4);
MD5STEP(F3, d, a, b, c, in[4] + 0x4bdecfa9, 11);
MD5STEP(F3, c, d, a, b, in[7] + 0xf6bb4b60, 16);
MD5STEP(F3, b, c, d, a, in[10] + 0xbebfbc70, 23);
MD5STEP(F3, a, b, c, d, in[13] + 0x289b7ec6, 4);
MD5STEP(F3, d, a, b, c, in[0] + 0xeaa127fa, 11);
MD5STEP(F3, c, d, a, b, in[3] + 0xd4ef3085, 16);
MD5STEP(F3, b, c, d, a, in[6] + 0x04881d05, 23);
MD5STEP(F3, a, b, c, d, in[9] + 0xd9d4d039, 4);
MD5STEP(F3, d, a, b, c, in[12] + 0xe6db99e5, 11);
MD5STEP(F3, c, d, a, b, in[15] + 0x1fa27cf8, 16);
MD5STEP(F3, b, c, d, a, in[2] + 0xc4ac5665, 23);
MD5STEP(F4, a, b, c, d, in[0] + 0xf4292244, 6);
MD5STEP(F4, d, a, b, c, in[7] + 0x432aff97, 10);
MD5STEP(F4, c, d, a, b, in[14] + 0xab9423a7, 15);
MD5STEP(F4, b, c, d, a, in[5] + 0xfc93a039, 21);
MD5STEP(F4, a, b, c, d, in[12] + 0x655b59c3, 6);
MD5STEP(F4, d, a, b, c, in[3] + 0x8f0ccc92, 10);
MD5STEP(F4, c, d, a, b, in[10] + 0xffeff47d, 15);
MD5STEP(F4, b, c, d, a, in[1] + 0x85845dd1, 21);
MD5STEP(F4, a, b, c, d, in[8] + 0x6fa87e4f, 6);
MD5STEP(F4, d, a, b, c, in[15] + 0xfe2ce6e0, 10);
MD5STEP(F4, c, d, a, b, in[6] + 0xa3014314, 15);
MD5STEP(F4, b, c, d, a, in[13] + 0x4e0811a1, 21);
MD5STEP(F4, a, b, c, d, in[4] + 0xf7537e82, 6);
MD5STEP(F4, d, a, b, c, in[11] + 0xbd3af235, 10);
MD5STEP(F4, c, d, a, b, in[2] + 0x2ad7d2bb, 15);
MD5STEP(F4, b, c, d, a, in[9] + 0xeb86d391, 21);
buf[0] += a;
buf[1] += b;
buf[2] += c;
buf[3] += d;
}

View File

@@ -1,26 +0,0 @@
#ifndef MD5_H
#define MD5_H
#ifdef __alpha
typedef unsigned int uint32;
#else
typedef unsigned long uint32;
#endif
struct MD5Context {
uint32 buf[4];
uint32 bits[2];
unsigned char in[64];
};
extern void MD5Init();
extern void MD5Update();
extern void MD5Final();
extern void MD5Transform();
/*
* This is needed to make RSAREF happy on some MS-DOS compilers.
*/
typedef struct MD5Context MD5_CTX;
#endif /* !MD5_H */

View File

@@ -1,356 +0,0 @@
/*
** Copyright (C) 1998-1999 Greg Stein. All Rights Reserved.
**
** By using this file, you agree to the terms and conditions set forth in
** the LICENSE.html file which can be found at the top level of the mod_dav
** distribution or at http://www.webdav.org/mod_dav/license-1.html.
**
** Contact information:
** Greg Stein, PO Box 3151, Redmond, WA, 98073
** gstein@lyra.org, http://www.webdav.org/mod_dav/
*/
/*
** DAV opaquelocktoken scheme implementation
**
** Written 5/99 by Keith Wannamaker, wannamak@us.ibm.com
** Adapted from ISO/DCE RPC spec and a former Internet Draft
** by Leach and Salz:
** http://www.ics.uci.edu/pub/ietf/webdav/uuid-guid/draft-leach-uuids-guids-01
**
** Portions of the code are covered by the following license:
**
** Copyright (c) 1990- 1993, 1996 Open Software Foundation, Inc.
** Copyright (c) 1989 by Hewlett-Packard Company, Palo Alto, Ca. &
** Digital Equipment Corporation, Maynard, Mass.
** Copyright (c) 1998 Microsoft.
** To anyone who acknowledges that this file is provided "AS IS"
** without any express or implied warranty: permission to use, copy,
** modify, and distribute this file for any purpose is hereby
** granted without fee, provided that the above copyright notices and
** this notice appears in all source code copies, and that none of
** the names of Open Software Foundation, Inc., Hewlett-Packard
** Company, or Digital Equipment Corporation be used in advertising
** or publicity pertaining to distribution of the software without
** specific, written prior permission. Neither Open Software
** Foundation, Inc., Hewlett-Packard Company, Microsoft, nor Digital Equipment
** Corporation makes any representations about the suitability of
** this software for any purpose.
*/
#include <string.h>
#include <stdio.h>
#include <stdlib.h>
#include <time.h>
#include "md5.h"
#include "token.h"
#ifdef WIN32
#include <windows.h>
#else
#include <sys/types.h>
#include <sys/time.h>
#include <sys/sysinfo.h>
#endif
/* set the following to the number of 100ns ticks of the actual resolution of
your system's clock */
#define UUIDS_PER_TICK 1024
/* Set this to what your compiler uses for 64 bit data type */
#ifdef WIN32
#define unsigned64_t unsigned __int64
#define I64(C) C
#else
#define unsigned64_t unsigned long long
#define I64(C) C##LL
#endif
typedef unsigned64_t uuid_time_t;
const uuid_t null_locktoken = {0};
static void format_uuid_v1(uuid_t * uuid, unsigned16 clockseq, uuid_time_t timestamp, uuid_node_t node);
static void get_current_time(uuid_time_t * timestamp);
static unsigned16 true_random(void);
static void get_pseudo_node_identifier(uuid_node_t *node);
static void get_system_time(uuid_time_t *uuid_time);
static void get_random_info(unsigned char seed[16]);
/* dav_create_opaquelocktoken - generates a UUID version 1 token.
* Clock_sequence and node_address set to pseudo-random
* numbers during init.
*
* Should postpend pid to account for non-seralized creation?
*/
int create_token(uuid_state *st, uuid_t *u)
{
uuid_time_t timestamp;
get_current_time(&timestamp);
format_uuid_v1(u, st->cs, timestamp, st->node);
return 1;
}
/*
* dav_create_uuid_state - seed UUID state with pseudorandom data
*/
void create_uuid_state(uuid_state *st)
{
st->cs = true_random();
get_pseudo_node_identifier(&st->node);
}
/*
* dav_format_opaquelocktoken - generates a text representation
* of an opaquelocktoken
*/
void format_token(char *target, const uuid_t *u)
{
sprintf(target, "%08lx-%04x-%04x-%02x%02x-%02x%02x%02x%02x%02x%02x",
u->time_low, u->time_mid, u->time_hi_and_version,
u->clock_seq_hi_and_reserved, u->clock_seq_low,
u->node[0], u->node[1], u->node[2],
u->node[3], u->node[4], u->node[5]);
}
/* convert a pair of hex digits to an integer value [0,255] */
static int dav_parse_hexpair(const char *s)
{
int result;
int temp;
result = s[0] - '0';
if (result > 48)
result = (result - 39) << 4;
else if (result > 16)
result = (result - 7) << 4;
else
result = result << 4;
temp = s[1] - '0';
if (temp > 48)
result |= temp - 39;
else if (temp > 16)
result |= temp - 7;
else
result |= temp;
return result;
}
/* dav_parse_locktoken: Parses string produced from
* dav_format_opaquelocktoken back into a uuid_t
* structure. On failure, return DAV_IF_ERROR_PARSE,
* else DAV_IF_ERROR_NONE.
*/
int parse_token(const char *char_token, uuid_t *bin_token)
{
int i;
for (i = 0; i < 36; ++i) {
char c = char_token[i];
if (!isxdigit(c) &&
!(c == '-' && (i == 8 || i == 13 || i == 18 || i == 23)))
return -1;
}
if (char_token[36] != '\0')
return -1;
bin_token->time_low =
(dav_parse_hexpair(&char_token[0]) << 24) |
(dav_parse_hexpair(&char_token[2]) << 16) |
(dav_parse_hexpair(&char_token[4]) << 8) |
dav_parse_hexpair(&char_token[6]);
bin_token->time_mid =
(dav_parse_hexpair(&char_token[9]) << 8) |
dav_parse_hexpair(&char_token[11]);
bin_token->time_hi_and_version =
(dav_parse_hexpair(&char_token[14]) << 8) |
dav_parse_hexpair(&char_token[16]);
bin_token->clock_seq_hi_and_reserved = dav_parse_hexpair(&char_token[19]);
bin_token->clock_seq_low = dav_parse_hexpair(&char_token[21]);
for (i = 6; i--;)
bin_token->node[i] = dav_parse_hexpair(&char_token[i*2+24]);
return -1;
}
/* dav_compare_opaquelocktoken:
* < 0 : a < b
* == 0 : a = b
* > 0 : a > b
*/
int compare_token(const uuid_t a, const uuid_t b)
{
return memcmp(&a, &b, sizeof(uuid_t));
}
/* format_uuid_v1 -- make a UUID from the timestamp, clockseq, and node ID */
static void format_uuid_v1(uuid_t * uuid, unsigned16 clock_seq,
uuid_time_t timestamp, uuid_node_t node)
{
/* Construct a version 1 uuid with the information we've gathered
* plus a few constants. */
uuid->time_low = (unsigned long)(timestamp & 0xFFFFFFFF);
uuid->time_mid = (unsigned short)((timestamp >> 32) & 0xFFFF);
uuid->time_hi_and_version = (unsigned short)((timestamp >> 48) & 0x0FFF);
uuid->time_hi_and_version |= (1 << 12);
uuid->clock_seq_low = clock_seq & 0xFF;
uuid->clock_seq_hi_and_reserved = (clock_seq & 0x3F00) >> 8;
uuid->clock_seq_hi_and_reserved |= 0x80;
memcpy(&uuid->node, &node, sizeof uuid->node);
}
/* get-current_time -- get time as 60 bit 100ns ticks since whenever.
Compensate for the fact that real clock resolution is less than 100ns. */
static void get_current_time(uuid_time_t * timestamp)
{
uuid_time_t time_now;
static uuid_time_t time_last;
static unsigned16 uuids_this_tick;
static int inited = 0;
if (!inited) {
get_system_time(&time_now);
uuids_this_tick = UUIDS_PER_TICK;
inited = 1;
};
while (1) {
get_system_time(&time_now);
/* if clock reading changed since last UUID generated... */
if (time_last != time_now) {
/* reset count of uuids gen'd with this clock reading */
uuids_this_tick = 0;
break;
};
if (uuids_this_tick < UUIDS_PER_TICK) {
uuids_this_tick++;
break;
}; /* going too fast for our clock; spin */
}; /* add the count of uuids to low order bits of the clock reading */
*timestamp = time_now + uuids_this_tick;
}
/* true_random -- generate a crypto-quality random number.
This sample doesn't do that. */
static unsigned16 true_random(void)
{
uuid_time_t time_now;
get_system_time(&time_now);
time_now = time_now/UUIDS_PER_TICK;
srand((unsigned int)(((time_now >> 32) ^ time_now)&0xffffffff));
return rand();
}
/* This sample implementation generates a random node ID *
* in lieu of a system dependent call to get IEEE node ID. */
static void get_pseudo_node_identifier(uuid_node_t *node)
{
unsigned char seed[16];
get_random_info(seed);
seed[0] |= 0x80;
memcpy(node, seed, sizeof(*node));
}
/* system dependent call to get the current system time.
Returned as 100ns ticks since Oct 15, 1582, but resolution may be
less than 100ns. */
#ifdef WIN32
static void get_system_time(uuid_time_t *uuid_time)
{
ULARGE_INTEGER time;
GetSystemTimeAsFileTime((FILETIME *)&time);
/* NT keeps time in FILETIME format which is 100ns ticks since
Jan 1, 1601. UUIDs use time in 100ns ticks since Oct 15, 1582.
The difference is 17 Days in Oct + 30 (Nov) + 31 (Dec)
+ 18 years and 5 leap days. */
time.QuadPart +=
(unsigned __int64) (1000*1000*10) // seconds
* (unsigned __int64) (60 * 60 * 24) // days
* (unsigned __int64) (17+30+31+365*18+5); // # of days
*uuid_time = time.QuadPart;
}
static void get_random_info(unsigned char seed[16])
{
MD5_CTX c;
struct {
MEMORYSTATUS m;
SYSTEM_INFO s;
FILETIME t;
LARGE_INTEGER pc;
DWORD tc;
DWORD l;
char hostname[MAX_COMPUTERNAME_LENGTH + 1];
} r;
MD5Init(&c); /* memory usage stats */
GlobalMemoryStatus(&r.m); /* random system stats */
GetSystemInfo(&r.s); /* 100ns resolution (nominally) time of day */
GetSystemTimeAsFileTime(&r.t); /* high resolution performance counter */
QueryPerformanceCounter(&r.pc); /* milliseconds since last boot */
r.tc = GetTickCount();
r.l = MAX_COMPUTERNAME_LENGTH + 1;
GetComputerName(r.hostname, &r.l );
MD5Update(&c, (const unsigned char *) &r, sizeof(r));
MD5Final(seed, &c);
}
#else /* WIN32 */
static void get_system_time(uuid_time_t *uuid_time)
{
struct timeval tp;
gettimeofday(&tp, (struct timezone *)0);
/* Offset between UUID formatted times and Unix formatted times.
UUID UTC base time is October 15, 1582.
Unix base time is January 1, 1970. */
*uuid_time = (tp.tv_sec * 10000000) + (tp.tv_usec * 10) +
I64(0x01B21DD213814000);
}
static void get_random_info(unsigned char seed[16])
{
MD5_CTX c;
/* Leech & Salz use Linux-specific struct sysinfo;
* replace with pid/tid for portability (in the spirit of mod_unique_id) */
struct {
/* Add thread id here, if applicable, when we get to pthread or apr */
pid_t pid;
struct timeval t;
char hostname[257];
} r;
MD5Init(&c);
r.pid = getpid();
gettimeofday(&r.t, (struct timezone *)0);
gethostname(r.hostname, 256);
MD5Update(&c, (const unsigned char *)&r, sizeof(r));
MD5Final(seed, &c);
}
#endif /* WIN32 */

View File

@@ -1,80 +0,0 @@
/*
** Copyright (C) 1998-1999 Greg Stein. All Rights Reserved.
**
** By using this file, you agree to the terms and conditions set forth in
** the LICENSE.html file which can be found at the top level of the mod_dav
** distribution or at http://www.webdav.org/mod_dav/license-1.html.
**
** Contact information:
** Greg Stein, PO Box 3151, Redmond, WA, 98073
** gstein@lyra.org, http://www.webdav.org/mod_dav/
*/
/*
** DAV opaquelocktoken scheme implementation
**
** Written 5/99 by Keith Wannamaker, wannamak@us.ibm.com
** Adapted from ISO/DCE RPC spec and a former Internet Draft
** by Leach and Salz:
** http://www.ics.uci.edu/pub/ietf/webdav/uuid-guid/draft-leach-uuids-guids-01
**
** Portions of the code are covered by the following license:
**
** Copyright (c) 1990- 1993, 1996 Open Software Foundation, Inc.
** Copyright (c) 1989 by Hewlett-Packard Company, Palo Alto, Ca. &
** Digital Equipment Corporation, Maynard, Mass.
** Copyright (c) 1998 Microsoft.
** To anyone who acknowledges that this file is provided "AS IS"
** without any express or implied warranty: permission to use, copy,
** modify, and distribute this file for any purpose is hereby
** granted without fee, provided that the above copyright notices and
** this notice appears in all source code copies, and that none of
** the names of Open Software Foundation, Inc., Hewlett-Packard
** Company, or Digital Equipment Corporation be used in advertising
** or publicity pertaining to distribution of the software without
** specific, written prior permission. Neither Open Software
** Foundation, Inc., Hewlett-Packard Company, Microsoft, nor Digital Equipment
** Corporation makes any representations about the suitability of
** this software for any purpose.
*/
#ifndef _TOKEN_H_
#define _TOKEN_H_
typedef unsigned long unsigned32;
typedef unsigned short unsigned16;
typedef unsigned char unsigned8;
typedef struct {
char nodeID[6];
} uuid_node_t;
#undef uuid_t
typedef struct _uuid_t
{
unsigned32 time_low;
unsigned16 time_mid;
unsigned16 time_hi_and_version;
unsigned8 clock_seq_hi_and_reserved;
unsigned8 clock_seq_low;
unsigned8 node[6];
} uuid_t;
/* data type for UUID generator persistent state */
typedef struct {
uuid_node_t node; /* saved node ID */
unsigned16 cs; /* saved clock sequence */
} uuid_state;
extern const uuid_t null_locktoken;
/* in dav_opaquelock.c */
int create_token(uuid_state *st, uuid_t *u);
void create_uuid_state(uuid_state *st);
void format_token(char *target, const uuid_t *u);
int compare_token(const uuid_t a, const uuid_t b);
int parse_token(const char *char_token, uuid_t *bin_token);
#endif /* _TOKEN_H_ */