usemod-1.0.4.pl 156 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817281828192820282128222823282428252826282728282829283028312832283328342835283628372838283928402841284228432844284528462847284828492850285128522853285428552856285728582859286028612862286328642865286628672868286928702871287228732874287528762877287828792880288128822883288428852886288728882889289028912892289328942895289628972898289929002901290229032904290529062907290829092910291129122913291429152916291729182919292029212922292329242925292629272928292929302931293229332934293529362937293829392940294129422943294429452946294729482949295029512952295329542955295629572958295929602961296229632964296529662967296829692970297129722973297429752976297729782979298029812982298329842985298629872988298929902991299229932994299529962997299829993000300130023003300430053006300730083009301030113012301330143015301630173018301930203021302230233024302530263027302830293030303130323033303430353036303730383039304030413042304330443045304630473048304930503051305230533054305530563057305830593060306130623063306430653066306730683069307030713072307330743075307630773078307930803081308230833084308530863087308830893090309130923093309430953096309730983099310031013102310331043105310631073108310931103111311231133114311531163117311831193120312131223123312431253126312731283129313031313132313331343135313631373138313931403141314231433144314531463147314831493150315131523153315431553156315731583159316031613162316331643165316631673168316931703171317231733174317531763177317831793180318131823183318431853186318731883189319031913192319331943195319631973198319932003201320232033204320532063207320832093210321132123213321432153216321732183219322032213222322332243225322632273228322932303231323232333234323532363237323832393240324132423243324432453246324732483249325032513252325332543255325632573258325932603261326232633264326532663267326832693270327132723273327432753276327732783279328032813282328332843285328632873288328932903291329232933294329532963297329832993300330133023303330433053306330733083309331033113312331333143315331633173318331933203321332233233324332533263327332833293330333133323333333433353336333733383339334033413342334333443345334633473348334933503351335233533354335533563357335833593360336133623363336433653366336733683369337033713372337333743375337633773378337933803381338233833384338533863387338833893390339133923393339433953396339733983399340034013402340334043405340634073408340934103411341234133414341534163417341834193420342134223423342434253426342734283429343034313432343334343435343634373438343934403441344234433444344534463447344834493450345134523453345434553456345734583459346034613462346334643465346634673468346934703471347234733474347534763477347834793480348134823483348434853486348734883489349034913492349334943495349634973498349935003501350235033504350535063507350835093510351135123513351435153516351735183519352035213522352335243525352635273528352935303531353235333534353535363537353835393540354135423543354435453546354735483549355035513552355335543555355635573558355935603561356235633564356535663567356835693570357135723573357435753576357735783579358035813582358335843585358635873588358935903591359235933594359535963597359835993600360136023603360436053606360736083609361036113612361336143615361636173618361936203621362236233624362536263627362836293630363136323633363436353636363736383639364036413642364336443645364636473648364936503651365236533654365536563657365836593660366136623663366436653666366736683669367036713672367336743675367636773678367936803681368236833684368536863687368836893690369136923693369436953696369736983699370037013702370337043705370637073708370937103711371237133714371537163717371837193720372137223723372437253726372737283729373037313732373337343735373637373738373937403741374237433744374537463747374837493750375137523753375437553756375737583759376037613762376337643765376637673768376937703771377237733774377537763777377837793780378137823783378437853786378737883789379037913792379337943795379637973798379938003801380238033804380538063807380838093810381138123813381438153816381738183819382038213822382338243825382638273828382938303831383238333834383538363837383838393840384138423843384438453846384738483849385038513852385338543855385638573858385938603861386238633864386538663867386838693870387138723873387438753876387738783879388038813882388338843885388638873888388938903891389238933894389538963897389838993900390139023903390439053906390739083909391039113912391339143915391639173918391939203921392239233924392539263927392839293930393139323933393439353936393739383939394039413942394339443945394639473948394939503951395239533954395539563957395839593960396139623963396439653966396739683969397039713972397339743975397639773978397939803981398239833984398539863987398839893990399139923993399439953996399739983999400040014002400340044005400640074008400940104011401240134014401540164017401840194020402140224023402440254026402740284029403040314032403340344035403640374038403940404041404240434044404540464047404840494050405140524053405440554056405740584059406040614062406340644065406640674068406940704071407240734074407540764077407840794080408140824083408440854086408740884089409040914092409340944095409640974098409941004101410241034104410541064107410841094110411141124113411441154116411741184119412041214122412341244125412641274128412941304131413241334134413541364137413841394140414141424143414441454146414741484149415041514152415341544155415641574158415941604161416241634164416541664167416841694170417141724173417441754176417741784179418041814182418341844185418641874188418941904191419241934194419541964197419841994200420142024203420442054206420742084209421042114212421342144215421642174218421942204221422242234224422542264227422842294230423142324233423442354236423742384239424042414242424342444245424642474248424942504251425242534254425542564257425842594260426142624263426442654266426742684269427042714272427342744275427642774278427942804281428242834284428542864287428842894290429142924293429442954296429742984299430043014302430343044305430643074308430943104311431243134314431543164317431843194320432143224323432443254326432743284329433043314332433343344335433643374338433943404341434243434344434543464347434843494350435143524353435443554356435743584359436043614362436343644365436643674368436943704371437243734374437543764377437843794380438143824383438443854386438743884389439043914392439343944395439643974398439944004401440244034404440544064407440844094410441144124413441444154416441744184419442044214422442344244425442644274428442944304431443244334434443544364437443844394440444144424443444444454446444744484449445044514452445344544455445644574458445944604461446244634464446544664467446844694470447144724473447444754476447744784479448044814482448344844485448644874488448944904491449244934494449544964497449844994500450145024503450445054506450745084509451045114512451345144515451645174518451945204521452245234524452545264527452845294530453145324533453445354536453745384539454045414542454345444545454645474548454945504551455245534554455545564557455845594560456145624563456445654566456745684569457045714572457345744575457645774578457945804581458245834584458545864587458845894590459145924593459445954596459745984599460046014602460346044605460646074608460946104611461246134614461546164617461846194620462146224623462446254626462746284629463046314632463346344635463646374638463946404641464246434644464546464647464846494650465146524653465446554656465746584659466046614662466346644665466646674668466946704671467246734674467546764677467846794680468146824683468446854686468746884689469046914692469346944695469646974698469947004701470247034704470547064707470847094710471147124713471447154716471747184719472047214722472347244725472647274728472947304731473247334734473547364737473847394740474147424743474447454746474747484749475047514752475347544755475647574758475947604761476247634764476547664767476847694770477147724773477447754776477747784779478047814782478347844785478647874788478947904791479247934794479547964797479847994800480148024803480448054806480748084809481048114812481348144815481648174818481948204821482248234824482548264827482848294830483148324833483448354836483748384839484048414842484348444845484648474848484948504851485248534854485548564857485848594860486148624863486448654866486748684869487048714872487348744875487648774878487948804881488248834884488548864887488848894890489148924893489448954896489748984899490049014902490349044905490649074908490949104911491249134914491549164917491849194920492149224923492449254926492749284929493049314932493349344935493649374938493949404941494249434944494549464947494849494950495149524953495449554956495749584959496049614962496349644965496649674968496949704971497249734974497549764977497849794980498149824983498449854986498749884989499049914992499349944995499649974998499950005001500250035004500550065007500850095010501150125013501450155016501750185019502050215022502350245025502650275028502950305031503250335034503550365037503850395040504150425043504450455046504750485049505050515052505350545055505650575058505950605061506250635064506550665067506850695070507150725073507450755076507750785079508050815082508350845085508650875088508950905091509250935094509550965097509850995100510151025103510451055106510751085109511051115112511351145115511651175118511951205121512251235124512551265127512851295130513151325133513451355136513751385139514051415142514351445145514651475148514951505151515251535154515551565157515851595160516151625163516451655166516751685169517051715172
  1. #!/usr/bin/perl
  2. # UseModWiki version 1.0.4 (December 1, 2007)
  3. # Copyright (C) 2000-2003 Clifford A. Adams <caadams@usemod.com>
  4. # Copyright (C) 2002-2003 Sunir Shah <sunir@sunir.org>
  5. # Based on the GPLed AtisWiki 0.3 (C) 1998 Markus Denker
  6. # <marcus@ira.uka.de>
  7. # ...which was based on
  8. # the LGPLed CVWiki CVS-patches (C) 1997 Peter Merel
  9. # and The Original WikiWikiWeb (C) Ward Cunningham
  10. # <ward@c2.com> (code reused with permission)
  11. # Email and ThinLine options by Jim Mahoney <mahoney@marlboro.edu>
  12. #
  13. # This program is free software; you can redistribute it and/or modify
  14. # it under the terms of the GNU General Public License as published by
  15. # the Free Software Foundation; either version 3 of the License, or
  16. # (at your option) any later version.
  17. #
  18. # This program is distributed in the hope that it will be useful,
  19. # but WITHOUT ANY WARRANTY; without even the implied warranty of
  20. # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  21. # GNU General Public License for more details.
  22. #
  23. # You should have received a copy of the GNU General Public License
  24. # along with this program. If not, see <http://www.gnu.org/licenses/>.
  25. package UseModWiki;
  26. use strict;
  27. local $| = 1; # Do not buffer output (localized for mod_perl)
  28. # Configuration/constant variables:
  29. use vars qw(@RcDays @HtmlPairs @HtmlSingle
  30. $TempDir $LockDir $DataDir $HtmlDir $UserDir $KeepDir $PageDir
  31. $InterFile $RcFile $RcOldFile $IndexFile $FullUrl $SiteName $HomePage
  32. $LogoUrl $RcDefault $IndentLimit $RecentTop $EditAllowed $UseDiff
  33. $UseSubpage $UseCache $RawHtml $SimpleLinks $NonEnglish $LogoLeft
  34. $KeepDays $HtmlTags $HtmlLinks $UseDiffLog $KeepMajor $KeepAuthor
  35. $FreeUpper $EmailNotify $SendMail $EmailFrom $FastGlob $EmbedWiki
  36. $ScriptTZ $BracketText $UseAmPm $UseConfig $UseIndex $UseLookup
  37. $RedirType $AdminPass $EditPass $UseHeadings $NetworkFile $BracketWiki
  38. $FreeLinks $WikiLinks $AdminDelete $FreeLinkPattern $RCName $RunCGI
  39. $ShowEdits $ThinLine $LinkPattern $InterLinkPattern $InterSitePattern
  40. $UrlProtocols $UrlPattern $ImageExtensions $RFCPattern $ISBNPattern
  41. $FS $FS1 $FS2 $FS3 $CookieName $SiteBase $StyleSheet $NotFoundPg
  42. $FooterNote $EditNote $MaxPost $NewText $NotifyDefault $HttpCharset
  43. $UserGotoBar $DeletedPage $ReplaceFile @ReplaceableFiles $TableSyntax
  44. $MetaKeywords $NamedAnchors $InterWikiMoniker $SiteDescription $RssLogoUrl
  45. $NumberDates $EarlyRules $LateRules $NewFS $KeepSize $SlashLinks $BGColor
  46. $UpperFirst $AdminBar $RepInterMap $DiffColor1 $DiffColor2 $ConfirmDel
  47. $MaskHosts $LockCrash $ConfigFile $HistoryEdit $OldThinLine
  48. @IsbnNames @IsbnPre @IsbnPost $EmailFile $FavIcon $RssDays $UserHeader
  49. $UserBody $StartUID $ParseParas $AuthorFooter $UseUpload $AllUpload
  50. $UploadDir $UploadUrl $LimitFileUrl $MaintTrimRc $SearchButton
  51. $EditNameLink $UseMetaWiki @ImageSites $BracketImg );
  52. # Note: $NotifyDefault is kept because it was a config variable in 0.90
  53. # Other global variables:
  54. use vars qw(%Page %Section %Text %InterSite %SaveUrl %SaveNumUrl
  55. %KeptRevisions %UserCookie %SetCookie %UserData %IndexHash %Translate
  56. %LinkIndex $InterSiteInit $SaveUrlIndex $SaveNumUrlIndex $MainPage
  57. $OpenPageName @KeptList @IndexList $IndexInit $TableMode
  58. $q $Now $UserID $TimeZoneOffset $ScriptName $BrowseCode $OtherCode
  59. $AnchoredLinkPattern @HeadingNumbers $TableOfContents $QuotedFullUrl
  60. $ConfigError $UploadPattern );
  61. # == Configuration =====================================================
  62. $DataDir = "/tmp/mywikidb"; # Main wiki directory
  63. $UseConfig = 1; # 1 = use config file, 0 = do not look for config
  64. $ConfigFile = "$DataDir/config"; # Configuration file
  65. # Default configuration (used if UseConfig is 0)
  66. $CookieName = "Wiki"; # Name for this wiki (for multi-wiki sites)
  67. $SiteName = "Wiki"; # Name of site (used for titles)
  68. $HomePage = "HomePage"; # Home page (change space to _)
  69. $RCName = "RecentChanges"; # Name of changes page (change space to _)
  70. $LogoUrl = "/wiki.gif"; # URL for site logo ("" for no logo)
  71. $ENV{PATH} = "/usr/bin/"; # Path used to find "diff"
  72. $ScriptTZ = ""; # Local time zone ("" means do not print)
  73. $RcDefault = 30; # Default number of RecentChanges days
  74. @RcDays = qw(1 3 7 30 90); # Days for links on RecentChanges
  75. $KeepDays = 14; # Days to keep old revisions
  76. $SiteBase = ""; # Full URL for <BASE> header
  77. $FullUrl = ""; # Set if the auto-detected URL is wrong
  78. $RedirType = 1; # 1 = CGI.pm, 2 = script, 3 = no redirect
  79. $AdminPass = ""; # Set to non-blank to enable password(s)
  80. $EditPass = ""; # Like AdminPass, but for editing only
  81. $StyleSheet = ""; # URL for CSS stylesheet (like "/wiki.css")
  82. $NotFoundPg = ""; # Page for not-found links ("" for blank pg)
  83. $EmailFrom = "Wiki"; # Text for "From: " field of email notes.
  84. $SendMail = "/usr/sbin/sendmail"; # Full path to sendmail executable
  85. $FooterNote = ""; # HTML for bottom of every page
  86. $EditNote = ""; # HTML notice above buttons on edit page
  87. $MaxPost = 1024 * 210; # Maximum 210K posts (about 200K for pages)
  88. $NewText = ""; # New page text ("" for default message)
  89. $HttpCharset = ""; # Charset for pages, like "iso-8859-2"
  90. $UserGotoBar = ""; # HTML added to end of goto bar
  91. $InterWikiMoniker = ''; # InterWiki moniker for this wiki. (for RSS)
  92. $SiteDescription = $SiteName; # Description of this wiki. (for RSS)
  93. $RssLogoUrl = ''; # Optional image for RSS feed
  94. $EarlyRules = ''; # Local syntax rules for wiki->html (evaled)
  95. $LateRules = ''; # Local syntax rules for wiki->html (evaled)
  96. $KeepSize = 0; # If non-zero, maximum size of keep file
  97. $BGColor = 'white'; # Background color ('' to disable)
  98. $DiffColor1 = '#ffffaf'; # Background color of old/deleted text
  99. $DiffColor2 = '#cfffcf'; # Background color of new/added text
  100. $FavIcon = ''; # URL of bookmark/favorites icon, or ''
  101. $RssDays = 7; # Default number of days in RSS feed
  102. $UserHeader = ''; # Optional HTML header additional content
  103. $UserBody = ''; # Optional <BODY> tag additional content
  104. $StartUID = 1001; # Starting number for user IDs
  105. $UploadDir = ''; # Full path (like /foo/www/uploads) for files
  106. $UploadUrl = ''; # Full URL (like http://foo.com/uploads)
  107. @ImageSites = qw(); # Url prefixes of good image sites: ()=all
  108. # Major options:
  109. $UseSubpage = 1; # 1 = use subpages, 0 = do not use subpages
  110. $UseCache = 0; # 1 = cache HTML pages, 0 = generate every page
  111. $EditAllowed = 1; # 1 = editing allowed, 0 = read-only
  112. $RawHtml = 0; # 1 = allow <HTML> tag, 0 = no raw HTML in pages
  113. $HtmlTags = 0; # 1 = "unsafe" HTML tags, 0 = only minimal tags
  114. $UseDiff = 1; # 1 = use diff features, 0 = do not use diff
  115. $FreeLinks = 1; # 1 = use [[word]] links, 0 = LinkPattern only
  116. $WikiLinks = 1; # 1 = use LinkPattern, 0 = use [[word]] only
  117. $AdminDelete = 1; # 1 = Admin only deletes, 0 = Editor can delete
  118. $RunCGI = 1; # 1 = Run script as CGI, 0 = Load but do not run
  119. $EmailNotify = 0; # 1 = use email notices, 0 = no email on changes
  120. $EmbedWiki = 0; # 1 = no headers/footers, 0 = normal wiki pages
  121. $DeletedPage = 'DeletedPage'; # 0 = disable, 'PageName' = tag to delete page
  122. $ReplaceFile = 'ReplaceFile'; # 0 = disable, 'PageName' = indicator tag
  123. @ReplaceableFiles = (); # List of allowed server files to replace
  124. $TableSyntax = 1; # 1 = wiki syntax tables, 0 = no table syntax
  125. $NewFS = 0; # 1 = new multibyte $FS, 0 = old $FS
  126. $UseUpload = 0; # 1 = allow uploads, 0 = no uploads
  127. # Minor options:
  128. $LogoLeft = 0; # 1 = logo on left, 0 = logo on right
  129. $RecentTop = 1; # 1 = recent on top, 0 = recent on bottom
  130. $UseDiffLog = 1; # 1 = save diffs to log, 0 = do not save diffs
  131. $KeepMajor = 1; # 1 = keep major rev, 0 = expire all revisions
  132. $KeepAuthor = 1; # 1 = keep author rev, 0 = expire all revisions
  133. $ShowEdits = 0; # 1 = show minor edits, 0 = hide edits by default
  134. $HtmlLinks = 0; # 1 = allow A HREF links, 0 = no raw HTML links
  135. $SimpleLinks = 0; # 1 = only letters, 0 = allow _ and numbers
  136. $NonEnglish = 0; # 1 = extra link chars, 0 = only A-Za-z chars
  137. $ThinLine = 0; # 1 = fancy <hr> tags, 0 = classic wiki <hr>
  138. $BracketText = 1; # 1 = allow [URL text], 0 = no link descriptions
  139. $UseAmPm = 1; # 1 = use am/pm in times, 0 = use 24-hour times
  140. $UseIndex = 0; # 1 = use index file, 0 = slow/reliable method
  141. $UseHeadings = 1; # 1 = allow = h1 text =, 0 = no header formatting
  142. $NetworkFile = 1; # 1 = allow remote file:, 0 = no file:// links
  143. $BracketWiki = 0; # 1 = [WikiLnk txt] link, 0 = no local descriptions
  144. $UseLookup = 1; # 1 = lookup host names, 0 = skip lookup (IP only)
  145. $FreeUpper = 1; # 1 = force upper case, 0 = do not force case
  146. $FastGlob = 1; # 1 = new faster code, 0 = old compatible code
  147. $MetaKeywords = 1; # 1 = Google-friendly, 0 = search-engine averse
  148. $NamedAnchors = 1; # 0 = no anchors, 1 = enable anchors,
  149. # 2 = enable but suppress display
  150. $SlashLinks = 0; # 1 = use script/action links, 0 = script?action
  151. $UpperFirst = 1; # 1 = free links start uppercase, 0 = no ucfirst
  152. $AdminBar = 1; # 1 = admins see admin links, 0 = no admin bar
  153. $RepInterMap = 0; # 1 = intermap is replacable, 0 = not replacable
  154. $ConfirmDel = 1; # 1 = delete link confirm page, 0 = immediate delete
  155. $MaskHosts = 0; # 1 = mask hosts/IPs, 0 = no masking
  156. $LockCrash = 0; # 1 = crash if lock stuck, 0 = auto clear locks
  157. $HistoryEdit = 0; # 1 = edit links on history page, 0 = no edit links
  158. $OldThinLine = 0; # 1 = old ==== thick line, 0 = ------ for thick line
  159. $NumberDates = 0; # 1 = 2003-6-17 dates, 0 = June 17, 2003 dates
  160. $ParseParas = 0; # 1 = new paragraph markup, 0 = old markup
  161. $AuthorFooter = 1; # 1 = show last author in footer, 0 = do not show
  162. $AllUpload = 0; # 1 = anyone can upload, 0 = only editor/admins
  163. $LimitFileUrl = 1; # 1 = limited use of file: URLs, 0 = no limits
  164. $MaintTrimRc = 0; # 1 = maintain action trims RC, 0 = only maintainrc
  165. $SearchButton = 0; # 1 = search button on page, 0 = old behavior
  166. $EditNameLink = 0; # 1 = edit links use name (CSS), 0 = '?' links
  167. $UseMetaWiki = 0; # 1 = add MetaWiki search links, 0 = no MW links
  168. $BracketImg = 1; # 1 = [url url.gif] becomes image link, 0 = no img
  169. # Names of sites. (The first entry is used for the number link.)
  170. @IsbnNames = ('bn.com', 'amazon.com', 'search');
  171. # Full URL of each site before the ISBN
  172. @IsbnPre = ('http://search.barnesandnoble.com/booksearch/isbninquiry.asp?isbn=',
  173. 'http://www.amazon.com/exec/obidos/ISBN=',
  174. 'http://www.pricescan.com/books/BookDetail.asp?isbn=');
  175. # Rest of URL of each site after the ISBN (usually '')
  176. @IsbnPost = ('', '', '');
  177. # HTML tag lists, enabled if $HtmlTags is set.
  178. # Scripting is currently possible with these tags,
  179. # so they are *not* particularly "safe".
  180. # Tags that must be in <tag> ... </tag> pairs:
  181. @HtmlPairs = qw(b i u font big small sub sup h1 h2 h3 h4 h5 h6 cite code
  182. em s strike strong tt var div center blockquote ol ul dl table caption);
  183. # Single tags (that do not require a closing /tag)
  184. @HtmlSingle = qw(br p hr li dt dd tr td th);
  185. @HtmlPairs = (@HtmlPairs, @HtmlSingle); # All singles can also be pairs
  186. # == You should not have to change anything below this line. =============
  187. $IndentLimit = 20; # Maximum depth of nested lists
  188. $PageDir = "$DataDir/page"; # Stores page data
  189. $HtmlDir = "$DataDir/html"; # Stores HTML versions
  190. $UserDir = "$DataDir/user"; # Stores user data
  191. $KeepDir = "$DataDir/keep"; # Stores kept (old) page data
  192. $TempDir = "$DataDir/temp"; # Temporary files and locks
  193. $LockDir = "$TempDir/lock"; # DB is locked if this exists
  194. $InterFile = "$DataDir/intermap"; # Interwiki site->url map
  195. $RcFile = "$DataDir/rclog"; # New RecentChanges logfile
  196. $RcOldFile = "$DataDir/oldrclog"; # Old RecentChanges logfile
  197. $IndexFile = "$DataDir/pageidx"; # List of all pages
  198. $EmailFile = "$DataDir/emails"; # Email notification lists
  199. if ($RepInterMap) {
  200. push @ReplaceableFiles, $InterFile;
  201. }
  202. # The "main" program, called at the end of this script file.
  203. sub DoWikiRequest {
  204. if ($UseConfig && (-f $ConfigFile)) {
  205. $ConfigError = '';
  206. if (!do $ConfigFile) { # Some error occurred
  207. $ConfigError = $@;
  208. if ($ConfigError eq '') {
  209. # Unfortunately, if the last expr returns 0, one will get a false
  210. # error above. To remain compatible with existing installs the
  211. # wiki must not report an error unless there is error text in $@.
  212. # (Errors in "use strict" may not have error text.)
  213. # Uncomment the line below if you want to catch use strict errors.
  214. # $ConfigError = T('Unknown Error (no error text)');
  215. }
  216. }
  217. }
  218. &InitLinkPatterns();
  219. if (!&DoCacheBrowse()) {
  220. eval $BrowseCode;
  221. &InitRequest() or return;
  222. if (!&DoBrowseRequest()) {
  223. eval $OtherCode;
  224. &DoOtherRequest();
  225. }
  226. }
  227. }
  228. # == Common and cache-browsing code ====================================
  229. sub InitLinkPatterns {
  230. my ($UpperLetter, $LowerLetter, $AnyLetter, $LpA, $LpB, $QDelim);
  231. # Field separators are used in the URL-style patterns below.
  232. if ($NewFS) {
  233. $FS = "\x1e\xff\xfe\x1e"; # An unlikely sequence for any charset
  234. } else {
  235. $FS = "\xb3"; # The FS character is a superscript "3"
  236. }
  237. $FS1 = $FS . "1"; # The FS values are used to separate fields
  238. $FS2 = $FS . "2"; # in stored hashtables and other data structures.
  239. $FS3 = $FS . "3"; # The FS character is not allowed in user data.
  240. $UpperLetter = "[A-Z";
  241. $LowerLetter = "[a-z";
  242. $AnyLetter = "[A-Za-z";
  243. if ($NonEnglish) {
  244. $UpperLetter .= "\xc0-\xde";
  245. $LowerLetter .= "\xdf-\xff";
  246. if ($NewFS) {
  247. $AnyLetter .= "\x80-\xff";
  248. } else {
  249. $AnyLetter .= "\xc0-\xff";
  250. }
  251. }
  252. if (!$SimpleLinks) {
  253. $AnyLetter .= "_0-9";
  254. }
  255. $UpperLetter .= "]"; $LowerLetter .= "]"; $AnyLetter .= "]";
  256. # Main link pattern: lowercase between uppercase, then anything
  257. $LpA = $UpperLetter . "+" . $LowerLetter . "+" . $UpperLetter
  258. . $AnyLetter . "*";
  259. # Optional subpage link pattern: uppercase, lowercase, then anything
  260. $LpB = $UpperLetter . "+" . $LowerLetter . "+" . $AnyLetter . "*";
  261. if ($UseSubpage) {
  262. # Loose pattern: If subpage is used, subpage may be simple name
  263. $LinkPattern = "((?:(?:$LpA)?\\/$LpB)|$LpA)";
  264. # Strict pattern: both sides must be the main LinkPattern
  265. # $LinkPattern = "((?:(?:$LpA)?\\/)?$LpA)";
  266. } else {
  267. $LinkPattern = "($LpA)";
  268. }
  269. $QDelim = '(?:"")?'; # Optional quote delimiter (not in output)
  270. $AnchoredLinkPattern = $LinkPattern . '#(\\w+)' . $QDelim if $NamedAnchors;
  271. $LinkPattern .= $QDelim;
  272. # Inter-site convention: sites must start with uppercase letter
  273. # (Uppercase letter avoids confusion with URLs)
  274. $InterSitePattern = $UpperLetter . $AnyLetter . "+";
  275. $InterLinkPattern = "((?:$InterSitePattern:[^\\]\\s\"<>$FS]+)$QDelim)";
  276. if ($FreeLinks) {
  277. # Note: the - character must be first in $AnyLetter definition
  278. if ($NonEnglish) {
  279. if ($NewFS) {
  280. $AnyLetter = "[-,.()' _0-9A-Za-z\x80-\xff]";
  281. } else {
  282. $AnyLetter = "[-,.()' _0-9A-Za-z\xc0-\xff]";
  283. }
  284. } else {
  285. $AnyLetter = "[-,.()' _0-9A-Za-z]";
  286. }
  287. }
  288. $FreeLinkPattern = "($AnyLetter+)";
  289. if ($UseSubpage) {
  290. $FreeLinkPattern = "((?:(?:$AnyLetter+)?\\/)?$AnyLetter+)";
  291. }
  292. $FreeLinkPattern .= $QDelim;
  293. # Url-style links are delimited by one of:
  294. # 1. Whitespace (kept in output)
  295. # 2. Left or right angle-bracket (< or >) (kept in output)
  296. # 3. Right square-bracket (]) (kept in output)
  297. # 4. A single double-quote (") (kept in output)
  298. # 5. A $FS (field separator) character (kept in output)
  299. # 6. A double double-quote ("") (removed from output)
  300. $UrlProtocols = "http|https|ftp|afs|news|nntp|mid|cid|mailto|wais|"
  301. . "prospero|telnet|gopher";
  302. $UrlProtocols .= '|file' if ($NetworkFile || !$LimitFileUrl);
  303. $UrlPattern = "((?:(?:$UrlProtocols):[^\\]\\s\"<>$FS]+)$QDelim)";
  304. $ImageExtensions = "(gif|jpg|png|bmp|jpeg|ico|tiff?)";
  305. $RFCPattern = "RFC\\s?(\\d+)";
  306. $ISBNPattern = "ISBN:?([0-9- xX]{10,})";
  307. $UploadPattern = "upload:([^\\]\\s\"<>$FS]+)$QDelim";
  308. }
  309. # Simple HTML cache
  310. sub DoCacheBrowse {
  311. my ($query, $idFile, $text);
  312. return 0 if (!$UseCache);
  313. $query = $ENV{'QUERY_STRING'};
  314. if (($query eq "") && ($ENV{'REQUEST_METHOD'} eq "GET")) {
  315. $query = $HomePage; # Allow caching of home page.
  316. }
  317. if (!($query =~ /^$LinkPattern$/)) {
  318. if (!($FreeLinks && ($query =~ /^$FreeLinkPattern$/))) {
  319. return 0; # Only use cache for simple links
  320. }
  321. }
  322. $idFile = &GetHtmlCacheFile($query);
  323. if (-f $idFile) {
  324. local $/ = undef; # Read complete files
  325. open(INFILE, "<$idFile") or return 0;
  326. $text = <INFILE>;
  327. close INFILE;
  328. print $text;
  329. return 1;
  330. }
  331. return 0;
  332. }
  333. sub GetHtmlCacheFile {
  334. my ($id) = @_;
  335. return $HtmlDir . "/" . &GetPageDirectory($id) . "/$id.htm";
  336. }
  337. sub GetPageDirectory {
  338. my ($id) = @_;
  339. if ($id =~ /^([a-zA-Z])/) {
  340. return uc($1);
  341. }
  342. return "other";
  343. }
  344. sub T {
  345. my ($text) = @_;
  346. if (defined($Translate{$text}) && ($Translate{$text} ne '')) {
  347. return $Translate{$text};
  348. }
  349. return $text;
  350. }
  351. sub Ts {
  352. my ($text, $string, $noquote) = @_;
  353. $string = &QuoteHtml($string) unless $noquote;
  354. $text = T($text);
  355. $text =~ s/\%s/$string/;
  356. return $text;
  357. }
  358. sub Tss {
  359. my $text = $_[0];
  360. my @args = @_;
  361. @args = map {
  362. $_ = &QuoteHtml($_);
  363. } @args;
  364. $text = T($text);
  365. $text =~ s/\%([1-9])/$args[$1]/ge;
  366. return $text;
  367. }
  368. sub QuoteHtml {
  369. my ($html) = @_;
  370. $html =~ s/&/&amp;/g;
  371. $html =~ s/</&lt;/g;
  372. $html =~ s/>/&gt;/g;
  373. $html =~ s/&amp;([#a-zA-Z0-9]+);/&$1;/g; # Allow character references
  374. return $html;
  375. }
  376. # == Normal page-browsing and RecentChanges code =======================
  377. $BrowseCode = ""; # Comment next line to always compile (slower)
  378. #$BrowseCode = <<'#END_OF_BROWSE_CODE';
  379. use CGI;
  380. use CGI::Carp qw(fatalsToBrowser);
  381. sub InitRequest {
  382. my @ScriptPath = split('/', "$ENV{SCRIPT_NAME}");
  383. $CGI::POST_MAX = $MaxPost;
  384. if ($UseUpload) {
  385. $CGI::DISABLE_UPLOADS = 0; # allow uploads
  386. } else {
  387. $CGI::DISABLE_UPLOADS = 1; # no uploads
  388. }
  389. $q = new CGI;
  390. # Fix some issues with editing UTF8 pages (if charset specified)
  391. if ($HttpCharset ne '') {
  392. $q->charset($HttpCharset);
  393. }
  394. $Now = time; # Reset in case script is persistent
  395. $ScriptName = pop(@ScriptPath); # Name used in links
  396. $IndexInit = 0; # Must be reset for each request
  397. $InterSiteInit = 0;
  398. %InterSite = ();
  399. $MainPage = "."; # For subpages only, the name of the top-level page
  400. $OpenPageName = ""; # Currently open page
  401. &CreateDir($DataDir); # Create directory if it doesn't exist
  402. if (!-d $DataDir) {
  403. &ReportError(Ts('Could not create %s', $DataDir) . ": $!");
  404. return 0;
  405. }
  406. &InitCookie(); # Reads in user data
  407. return 1;
  408. }
  409. sub InitCookie {
  410. %SetCookie = ();
  411. $TimeZoneOffset = 0;
  412. undef $q->{'.cookies'}; # Clear cache if it exists (for SpeedyCGI)
  413. %UserData = (); # Fix for persistent environments.
  414. %UserCookie = $q->cookie($CookieName);
  415. $UserID = $UserCookie{'id'};
  416. $UserID =~ s/\D//g; # Numeric only
  417. if ($UserID < 200) {
  418. $UserID = 111;
  419. } else {
  420. &LoadUserData($UserID);
  421. }
  422. if ($UserID > 199) {
  423. if (($UserData{'id'} != $UserCookie{'id'}) ||
  424. ($UserData{'randkey'} != $UserCookie{'randkey'})) {
  425. $UserID = 113;
  426. %UserData = (); # Invalid. Consider warning message.
  427. }
  428. }
  429. if ($UserData{'tzoffset'} != 0) {
  430. $TimeZoneOffset = $UserData{'tzoffset'} * (60 * 60);
  431. }
  432. }
  433. sub DoBrowseRequest {
  434. my ($id, $action, $text);
  435. if (!$q->param) { # No parameter
  436. &BrowsePage($HomePage);
  437. return 1;
  438. }
  439. $id = &GetParam('keywords', '');
  440. if ($id) { # Just script?PageName
  441. if ($FreeLinks && (!-f &GetPageFile($id))) {
  442. $id = &FreeToNormal($id);
  443. }
  444. if (($NotFoundPg ne '') && (!-f &GetPageFile($id))) {
  445. $id = $NotFoundPg;
  446. }
  447. &BrowsePage($id) if &ValidIdOrDie($id);
  448. return 1;
  449. }
  450. $action = lc(&GetParam('action', ''));
  451. $id = &GetParam('id', '');
  452. if ($action eq 'browse') {
  453. if ($FreeLinks && (!-f &GetPageFile($id))) {
  454. $id = &FreeToNormal($id);
  455. }
  456. if (($NotFoundPg ne '') && (!-f &GetPageFile($id))) {
  457. $id = $NotFoundPg;
  458. }
  459. &BrowsePage($id) if &ValidIdOrDie($id);
  460. return 1;
  461. } elsif ($action eq 'rc') {
  462. &BrowsePage($RCName);
  463. return 1;
  464. } elsif ($action eq 'random') {
  465. &DoRandom();
  466. return 1;
  467. } elsif ($action eq 'history') {
  468. &DoHistory($id) if &ValidIdOrDie($id);
  469. return 1;
  470. }
  471. return 0; # Request not handled
  472. }
  473. sub BrowsePage {
  474. my ($id) = @_;
  475. my ($fullHtml, $oldId, $allDiff, $showDiff, $openKept);
  476. my ($revision, $goodRevision, $diffRevision, $newText);
  477. &OpenPage($id);
  478. &OpenDefaultText();
  479. $openKept = 0;
  480. $revision = &GetParam('revision', '');
  481. $revision =~ s/\D//g; # Remove non-numeric chars
  482. $goodRevision = $revision; # Non-blank only if exists
  483. if ($revision ne '') {
  484. &OpenKeptRevisions('text_default');
  485. $openKept = 1;
  486. if (!defined($KeptRevisions{$revision})) {
  487. $goodRevision = '';
  488. } else {
  489. &OpenKeptRevision($revision);
  490. }
  491. }
  492. # Raw mode: just untranslated wiki text
  493. if (&GetParam('raw', 0)) {
  494. print &GetHttpHeader('text/plain');
  495. print $Text{'text'};
  496. return;
  497. }
  498. $newText = $Text{'text'}; # For differences
  499. # Handle a single-level redirect
  500. $oldId = &GetParam('oldid', '');
  501. if (($oldId eq '') && (substr($Text{'text'}, 0, 10) eq '#REDIRECT ')) {
  502. $oldId = $id;
  503. if (($FreeLinks) && ($Text{'text'} =~ /\#REDIRECT\s+\[\[.+\]\]/)) {
  504. ($id) = ($Text{'text'} =~ /\#REDIRECT\s+\[\[(.+)\]\]/);
  505. $id = &FreeToNormal($id);
  506. } else {
  507. ($id) = ($Text{'text'} =~ /\#REDIRECT\s+(\S+)/);
  508. }
  509. if (&ValidId($id) eq '') {
  510. # Consider revision in rebrowse?
  511. &ReBrowsePage($id, $oldId, 0);
  512. return;
  513. } else { # Not a valid target, so continue as normal page
  514. $id = $oldId;
  515. $oldId = '';
  516. }
  517. }
  518. $MainPage = $id;
  519. $MainPage =~ s|/.*||; # Only the main page name (remove subpage)
  520. $fullHtml = &GetHeader($id, &QuoteHtml($id), $oldId, 1);
  521. if ($revision ne '') {
  522. if (($revision eq $Page{'revision'}) || ($goodRevision ne '')) {
  523. $fullHtml .= '<b>' . Ts('Showing revision %s', $revision) . "</b><br>";
  524. } else {
  525. $fullHtml .= '<b>' . Ts('Revision %s not available', $revision)
  526. . ' (' . T('showing current revision instead')
  527. . ')</b><br>';
  528. }
  529. }
  530. $allDiff = &GetParam('alldiff', 0);
  531. if ($allDiff != 0) {
  532. $allDiff = &GetParam('defaultdiff', 1);
  533. }
  534. if ((($id eq $RCName) || (T($RCName) eq $id) || (T($id) eq $RCName))
  535. && &GetParam('norcdiff', 1)) {
  536. $allDiff = 0; # Only show if specifically requested
  537. }
  538. $showDiff = &GetParam('diff', $allDiff);
  539. if ($UseDiff && $showDiff) {
  540. $diffRevision = $goodRevision;
  541. $diffRevision = &GetParam('diffrevision', $diffRevision);
  542. # Eventually try to avoid the following keep-loading if possible?
  543. &OpenKeptRevisions('text_default') if (!$openKept);
  544. $fullHtml .= &GetDiffHTML($showDiff, $id, $diffRevision,
  545. $revision, $newText);
  546. $fullHtml .= "<hr class=wikilinediff>\n";
  547. }
  548. $fullHtml .= '<div class=wikitext>';
  549. $fullHtml .= &WikiToHTML($Text{'text'});
  550. $fullHtml .= '</div>';
  551. if (($id eq $RCName) || (T($RCName) eq $id) || (T($id) eq $RCName)) {
  552. print $fullHtml;
  553. print "<hr class=wikilinerc>\n";
  554. print '<div class=wikirc>';
  555. &DoRc(1);
  556. print '</div>';
  557. print &GetFooterText($id, $goodRevision);
  558. return;
  559. }
  560. $fullHtml .= &GetFooterText($id, $goodRevision);
  561. print $fullHtml;
  562. return if ($showDiff || ($revision ne '')); # Don't cache special version
  563. &UpdateHtmlCache($id, $fullHtml) if ($UseCache && ($oldId eq ''));
  564. }
  565. sub ReBrowsePage {
  566. my ($id, $oldId, $isEdit) = @_;
  567. if ($oldId ne "") { # Target of #REDIRECT (loop breaking)
  568. print &GetRedirectPage("action=browse&id=$id&oldid=$oldId",
  569. $id, $isEdit);
  570. } else {
  571. print &GetRedirectPage($id, $id, $isEdit);
  572. }
  573. }
  574. sub DoRc {
  575. my ($rcType) = @_; # 0 = RSS, 1 = HTML
  576. my ($fileData, $rcline, $i, $daysago, $lastTs, $ts, $idOnly);
  577. my (@fullrc, $status, $oldFileData, $firstTs, $errorText, $showHTML);
  578. my $starttime = 0;
  579. my $showbar = 0;
  580. if (0 == $rcType) {
  581. $showHTML = 0;
  582. } else {
  583. $showHTML = 1;
  584. }
  585. if (&GetParam("from", 0)) {
  586. $starttime = &GetParam("from", 0);
  587. if ($showHTML) {
  588. print "<h2>" . Ts('Updates since %s', &TimeToText($starttime))
  589. . "</h2>\n";
  590. }
  591. } else {
  592. $daysago = &GetParam("days", 0);
  593. $daysago = &GetParam("rcdays", 0) if ($daysago == 0);
  594. if ($daysago) {
  595. $starttime = $Now - ((24*60*60)*$daysago);
  596. if ($showHTML) {
  597. print "<h2>" . Ts('Updates in the last %s day'
  598. . (($daysago != 1)?"s":""), $daysago) . "</h2>\n";
  599. }
  600. # Note: must have two translations (for "day" and "days")
  601. # Following comment line is for translation helper script
  602. # Ts('Updates in the last %s days', '');
  603. }
  604. }
  605. if ($starttime == 0) {
  606. if (0 == $rcType) {
  607. $starttime = $Now - ((24*60*60)*$RssDays);
  608. } else {
  609. $starttime = $Now - ((24*60*60)*$RcDefault);
  610. }
  611. if ($showHTML) {
  612. print "<h2>" . Ts('Updates in the last %s day'
  613. . (($RcDefault != 1)?"s":""), $RcDefault) . "</h2>\n";
  614. }
  615. # Translation of above line is identical to previous version
  616. }
  617. # Read rclog data (and oldrclog data if needed)
  618. ($status, $fileData) = &ReadFile($RcFile);
  619. $errorText = "";
  620. if (!$status) {
  621. # Save error text if needed.
  622. $errorText = '<p><strong>' . Ts('Could not open %s log file', $RCName)
  623. . ":</strong> $RcFile<p>"
  624. . T('Error was') . ":\n<pre>$!</pre>\n" . '<p>'
  625. . T('Note: This error is normal if no changes have been made.') . "\n";
  626. }
  627. @fullrc = split(/\n/, $fileData);
  628. $firstTs = 0;
  629. if (@fullrc > 0) { # Only false if no lines in file
  630. ($firstTs) = split(/$FS3/, $fullrc[0]);
  631. }
  632. if (($firstTs == 0) || ($starttime <= $firstTs)) {
  633. ($status, $oldFileData) = &ReadFile($RcOldFile);
  634. if ($status) {
  635. @fullrc = split(/\n/, $oldFileData . $fileData);
  636. } else {
  637. if ($errorText ne "") { # could not open either rclog file
  638. print $errorText;
  639. print "<p><strong>"
  640. . Ts('Could not open old %s log file', $RCName)
  641. . ":</strong> $RcOldFile<p>"
  642. . T('Error was') . ":\n<pre>$!</pre>\n";
  643. return;
  644. }
  645. }
  646. }
  647. $lastTs = 0;
  648. if (@fullrc > 0) { # Only false if no lines in file
  649. ($lastTs) = split(/$FS3/, $fullrc[$#fullrc]);
  650. }
  651. $lastTs++ if (($Now - $lastTs) > 5); # Skip last unless very recent
  652. $idOnly = &GetParam("rcidonly", "");
  653. if ($idOnly && $showHTML) {
  654. print '<b>(' . Ts('for %s only', &ScriptLink($idOnly, &QuoteHtml($idOnly)), 1)
  655. . ')</b><br>';
  656. }
  657. if ($showHTML) {
  658. foreach $i (@RcDays) {
  659. print " | " if $showbar;
  660. $showbar = 1;
  661. print &ScriptLink("action=rc&days=$i",
  662. Ts('%s day' . (($i != 1)?'s':''), $i));
  663. # Note: must have two translations (for "day" and "days")
  664. # Following comment line is for translation helper script
  665. # Ts('%s days', '');
  666. }
  667. print "<br>" . &ScriptLink("action=rc&from=$lastTs",
  668. T('List new changes starting from'));
  669. print " " . &TimeToText($lastTs) . "<br>\n";
  670. }
  671. $i = 0;
  672. while ($i < @fullrc) { # Optimization: skip old entries quickly
  673. ($ts) = split(/$FS3/, $fullrc[$i]);
  674. if ($ts >= $starttime) {
  675. $i -= 1000 if ($i > 0);
  676. last;
  677. }
  678. $i += 1000;
  679. }
  680. $i -= 1000 if (($i > 0) && ($i >= @fullrc));
  681. for (; $i < @fullrc ; $i++) {
  682. ($ts) = split(/$FS3/, $fullrc[$i]);
  683. last if ($ts >= $starttime);
  684. }
  685. if ($i == @fullrc && $showHTML) {
  686. print '<br><strong>' . Ts('No updates since %s',
  687. &TimeToText($starttime)) . "</strong><br>\n";
  688. } else {
  689. splice(@fullrc, 0, $i); # Remove items before index $i
  690. # Consider an end-time limit (items older than X)
  691. if (0 == $rcType) {
  692. print &GetRcRss(@fullrc);
  693. } else {
  694. print &GetRcHtml(@fullrc);
  695. }
  696. }
  697. if ($showHTML) {
  698. print '<p>' . Ts('Page generated %s', &TimeToText($Now)), "<br>\n";
  699. }
  700. }
  701. sub GetRc {
  702. my $rcType = shift;
  703. my @outrc = @_;
  704. my ($rcline, $date, $newtop, $author, $inlist, $result);
  705. my ($showedit, $link, $all, $idOnly, $headItem, $item);
  706. my ($ts, $pagename, $summary, $isEdit, $host, $kind, $extraTemp);
  707. my ($rcchangehist, $tEdit, $tChanges, $tDiff);
  708. my ($headList, $pagePrefix, $historyPrefix, $diffPrefix);
  709. my %extra = ();
  710. my %changetime = ();
  711. my %pagecount = ();
  712. # Slice minor edits
  713. $showedit = &GetParam("rcshowedit", $ShowEdits);
  714. $showedit = &GetParam("showedit", $showedit);
  715. if ($showedit != 1) {
  716. my @temprc = ();
  717. foreach $rcline (@outrc) {
  718. ($ts, $pagename, $summary, $isEdit, $host) = split(/$FS3/, $rcline);
  719. if ($showedit == 0) { # 0 = No edits
  720. push(@temprc, $rcline) if (!$isEdit);
  721. } else { # 2 = Only edits
  722. push(@temprc, $rcline) if ($isEdit);
  723. }
  724. }
  725. @outrc = @temprc;
  726. }
  727. # Optimize param fetches out of main loop
  728. $rcchangehist = &GetParam("rcchangehist", 1);
  729. # Optimize translations out of main loop
  730. $tEdit = T('(edit)');
  731. $tDiff = T('(diff)');
  732. $tChanges = T('changes');
  733. $pagePrefix = $QuotedFullUrl . &ScriptLinkChar();
  734. $diffPrefix = $pagePrefix . &QuoteHtml("action=browse&diff=4&id=");
  735. $historyPrefix = $pagePrefix . &QuoteHtml("action=history&id=");
  736. foreach $rcline (@outrc) {
  737. ($ts, $pagename) = split(/$FS3/, $rcline);
  738. $pagecount{$pagename}++;
  739. $changetime{$pagename} = $ts;
  740. }
  741. $date = "";
  742. $all = &GetParam("rcall", 0);
  743. $all = &GetParam("all", $all);
  744. $newtop = &GetParam("rcnewtop", $RecentTop);
  745. $newtop = &GetParam("newtop", $newtop);
  746. $idOnly = &GetParam("rcidonly", "");
  747. $inlist = 0;
  748. $headList = '';
  749. $result = '';
  750. @outrc = reverse @outrc if ($newtop);
  751. foreach $rcline (@outrc) {
  752. ($ts, $pagename, $summary, $isEdit, $host, $kind, $extraTemp)
  753. = split(/$FS3/, $rcline);
  754. next if ((!$all) && ($ts < $changetime{$pagename}));
  755. next if (($idOnly ne "") && ($idOnly ne $pagename));
  756. %extra = split(/$FS2/, $extraTemp, -1);
  757. if ($date ne &CalcDay($ts)) {
  758. $date = &CalcDay($ts);
  759. if (1 == $rcType) { # HTML
  760. # add date, properly closing lists first
  761. if ($inlist) {
  762. $result .= "</UL>\n";
  763. $inlist = 0;
  764. }
  765. $result .= "<p><strong>" . $date . "</strong></p>\n";
  766. if (!$inlist) {
  767. $result .= "<UL>\n";
  768. $inlist = 1;
  769. }
  770. }
  771. }
  772. if (0 == $rcType) { # RSS
  773. ($headItem, $item) = &GetRssRcLine($pagename, $ts, $host,
  774. $extra{'name'}, $extra{'id'}, $summary, $isEdit,
  775. $pagecount{$pagename}, $extra{'revision'},
  776. $diffPrefix, $historyPrefix, $pagePrefix);
  777. $headList .= $headItem;
  778. $result .= $item;
  779. } else { # HTML
  780. $result .= &GetHtmlRcLine($pagename, $ts, $host, $extra{'name'},
  781. $extra{'id'}, $summary, $isEdit,
  782. $pagecount{$pagename}, $extra{'revision'},
  783. $tEdit, $tDiff, $tChanges, $all, $rcchangehist);
  784. }
  785. }
  786. if (1 == $rcType) {
  787. $result .= "</UL>\n" if ($inlist); # Close final tag
  788. }
  789. return ($headList, $result); # Just ignore headList for HTML
  790. }
  791. sub GetRcHtml {
  792. my ($html, $extra);
  793. ($extra, $html) = &GetRc(1, @_);
  794. return $html;
  795. }
  796. sub GetHtmlRcLine {
  797. my ($pagename, $timestamp, $host, $userName, $userID, $summary,
  798. $isEdit, $pagecount, $revision, $tEdit, $tDiff, $tChanges, $all,
  799. $rcchangehist) = @_;
  800. my ($author, $sum, $edit, $count, $link, $html);
  801. $html = '';
  802. $host = &QuoteHtml($host);
  803. if (defined($userName) && defined($userID)) {
  804. $author = &GetAuthorLink($host, $userName, $userID);
  805. } else {
  806. $author = &GetAuthorLink($host, "", 0);
  807. }
  808. $sum = "";
  809. if (($summary ne "") && ($summary ne "*")) {
  810. $summary = &QuoteHtml($summary);
  811. $sum = "<strong>[$summary]</strong> ";
  812. }
  813. $edit = "";
  814. $edit = "<em>$tEdit</em> " if ($isEdit);
  815. $count = "";
  816. if ((!$all) && ($pagecount > 1)) {
  817. $count = "($pagecount ";
  818. if ($rcchangehist) {
  819. $count .= &GetHistoryLink($pagename, $tChanges);
  820. } else {
  821. $count .= $tChanges;
  822. }
  823. $count .= ") ";
  824. }
  825. $link = "";
  826. if ($UseDiff && &GetParam("diffrclink", 1)) {
  827. $link .= &ScriptLinkDiff(4, $pagename, $tDiff, "") . " ";
  828. }
  829. $link .= &GetPageLink($pagename);
  830. $html .= "<li>$link ";
  831. $html .= &CalcTime($timestamp) . " $count$edit" . " $sum";
  832. $html .= ". . . . . $author\n";
  833. return $html;
  834. }
  835. sub GetRcRss {
  836. my ($rssHeader, $headList, $items);
  837. # Normally get URL from script, but allow override
  838. $FullUrl = $q->url(-full=>1) if ($FullUrl eq "");
  839. $QuotedFullUrl = &QuoteHtml($FullUrl);
  840. $SiteDescription = &QuoteHtml($SiteDescription);
  841. my $ChannelAbout = &QuoteHtml($FullUrl . &ScriptLinkChar()
  842. . $ENV{QUERY_STRING});
  843. $rssHeader = <<RSS ;
  844. <?xml version="1.0" encoding="ISO-8859-1"?>
  845. <rdf:RDF
  846. xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#"
  847. xmlns="http://purl.org/rss/1.0/"
  848. xmlns:dc="http://purl.org/dc/elements/1.1/"
  849. xmlns:wiki="http://purl.org/rss/1.0/modules/wiki/"
  850. >
  851. <channel rdf:about="$ChannelAbout">
  852. <title>${\(&QuoteHtml($SiteName))}</title>
  853. <link>${\($QuotedFullUrl . &ScriptLinkChar() . &QuoteHtml("$RCName"))}</link>
  854. <description>${\(&QuoteHtml($SiteDescription))}</description>
  855. <wiki:interwiki>
  856. <rdf:Description link="$QuotedFullUrl">
  857. <rdf:value>$InterWikiMoniker</rdf:value>
  858. </rdf:Description>
  859. </wiki:interwiki>
  860. <items>
  861. <rdf:Seq>
  862. RSS
  863. ($headList, $items) = &GetRc(0, @_);
  864. $rssHeader .= $headList;
  865. return <<RSS ;
  866. $rssHeader
  867. </rdf:Seq>
  868. </items>
  869. </channel>
  870. <image rdf:about="${\(&QuoteHtml($RssLogoUrl))}">
  871. <title>${\(&QuoteHtml($SiteName))}</title>
  872. <url>$RssLogoUrl</url>
  873. <link>$QuotedFullUrl</link>
  874. </image>
  875. $items
  876. </rdf:RDF>
  877. RSS
  878. }
  879. sub GetRssRcLine{
  880. my ($pagename, $timestamp, $host, $userName, $userID, $summary, $isEdit,
  881. $pagecount, $revision, $diffPrefix, $historyPrefix, $pagePrefix) = @_;
  882. my ($pagenameEsc, $itemID, $description, $authorLink, $author, $status,
  883. $importance, $date, $item, $headItem);
  884. $pagenameEsc = CGI::escape($pagename);
  885. # Add to list of items in the <channel/>
  886. $itemID = $FullUrl . &ScriptLinkChar()
  887. . &GetOldPageParameters('browse', $pagenameEsc, $revision);
  888. $itemID = &QuoteHtml($itemID);
  889. $headItem = " <rdf:li rdf:resource=\"$itemID\"/>\n";
  890. # Add to list of items proper.
  891. if (($summary ne "") && ($summary ne "*")) {
  892. $description = &QuoteHtml($summary);
  893. }
  894. $host = &QuoteHtml($host);
  895. if ($userName) {
  896. $author = &QuoteHtml($userName);
  897. $authorLink = 'link="' . $QuotedFullUrl . &ScriptLinkChar() . $author . '"';
  898. } else {
  899. $author = $host;
  900. }
  901. $status = (1 == $revision) ? 'new' : 'updated';
  902. $importance = $isEdit ? 'minor' : 'major';
  903. $timestamp += $TimeZoneOffset;
  904. my ($sec, $min, $hour, $mday, $mon, $year) = localtime($timestamp);
  905. $year += 1900;
  906. $date = sprintf("%4d-%02d-%02dT%02d:%02d:%02d+%02d:00",
  907. $year, $mon+1, $mday, $hour, $min, $sec, $TimeZoneOffset/(60*60));
  908. $pagename = &QuoteHtml($pagename);
  909. # Write it out longhand
  910. $item = <<RSS ;
  911. <item rdf:about="$itemID">
  912. <title>$pagename</title>
  913. <link>$pagePrefix$pagenameEsc</link>
  914. <description>$description</description>
  915. <dc:date>$date</dc:date>
  916. <dc:contributor>
  917. <rdf:Description wiki:host="$host" $authorLink>
  918. <rdf:value>$author</rdf:value>
  919. </rdf:Description>
  920. </dc:contributor>
  921. <wiki:status>$status</wiki:status>
  922. <wiki:importance>$importance</wiki:importance>
  923. <wiki:diff>$diffPrefix$pagenameEsc</wiki:diff>
  924. <wiki:version>$revision</wiki:version>
  925. <wiki:history>$historyPrefix$pagenameEsc</wiki:history>
  926. </item>
  927. RSS
  928. return ($headItem, $item);
  929. }
  930. sub DoRss {
  931. print "Content-type: text/xml\n\n";
  932. &DoRc(0);
  933. }
  934. sub DoRandom {
  935. my ($id, @pageList);
  936. @pageList = &AllPagesList(); # Optimize?
  937. $id = $pageList[int(rand($#pageList + 1))];
  938. &ReBrowsePage($id, "", 0);
  939. }
  940. sub DoHistory {
  941. my ($id) = @_;
  942. my ($html, $canEdit, $row, $newText);
  943. print &GetHeader('', Ts('History of %s', $id), '') . '<br>';
  944. &OpenPage($id);
  945. &OpenDefaultText();
  946. $newText = $Text{'text'};
  947. $canEdit = 0;
  948. $canEdit = &UserCanEdit($id) if ($HistoryEdit);
  949. if ($UseDiff) {
  950. print <<EOF ;
  951. <form action="$ScriptName" METHOD="GET">
  952. <input type="hidden" name="action" value="browse"/>
  953. <input type="hidden" name="diff" value="1"/>
  954. <input type="hidden" name="id" value="$id"/>
  955. <table border="0" width="100%"><tr>
  956. EOF
  957. }
  958. $html = &GetHistoryLine($id, $Page{'text_default'}, $canEdit, $row++);
  959. &OpenKeptRevisions('text_default');
  960. foreach (reverse sort {$a <=> $b} keys %KeptRevisions) {
  961. next if ($_ eq ""); # (needed?)
  962. $html .= &GetHistoryLine($id, $KeptRevisions{$_}, $canEdit, $row++);
  963. }
  964. print $html;
  965. if ($UseDiff) {
  966. my $label = T('Compare');
  967. print "<tr><td align='center'><input type='submit' "
  968. . "value='$label'/>&nbsp;&nbsp;</td></table></form>\n";
  969. print "<hr class=wikilinediff>\n";
  970. print &GetDiffHTML(&GetParam('defaultdiff', 1), $id, '', '', $newText);
  971. }
  972. print &GetCommonFooter();
  973. }
  974. sub GetMaskedHost {
  975. my ($text) = @_;
  976. my ($logText);
  977. if (!$MaskHosts) {
  978. return $text;
  979. }
  980. $logText = T('(logged)');
  981. if (!($text =~ s/\d+$/$logText/)) { # IP address (ending numbers masked)
  982. $text =~ s/^[^\.\(]+/$logText/; # Host name: mask until first .
  983. }
  984. return $text;
  985. }
  986. sub GetHistoryLine {
  987. my ($id, $section, $canEdit, $row) = @_;
  988. my ($html, $expirets, $rev, $summary, $host, $user, $uid, $ts, $minor);
  989. my (%sect, %revtext);
  990. %sect = split(/$FS2/, $section, -1);
  991. %revtext = split(/$FS3/, $sect{'data'});
  992. $rev = $sect{'revision'};
  993. $summary = $revtext{'summary'};
  994. if ((defined($sect{'host'})) && ($sect{'host'} ne '')) {
  995. $host = $sect{'host'};
  996. } else {
  997. $host = $sect{'ip'};
  998. }
  999. $host = &GetMaskedHost($host);
  1000. $user = $sect{'username'};
  1001. $uid = $sect{'id'};
  1002. $ts = $sect{'ts'};
  1003. $minor = '';
  1004. $minor = '<i>' . T('(edit)') . '</i> ' if ($revtext{'minor'});
  1005. $expirets = $Now - ($KeepDays * 24 * 60 * 60);
  1006. if ($UseDiff) {
  1007. my ($c1, $c2);
  1008. $c1 = 'checked="checked"' if 1 == $row;
  1009. $c2 = 'checked="checked"' if 0 == $row;
  1010. $html .= "<tr><td align='center'><input type='radio' "
  1011. . "name='diffrevision' value='$rev' $c1/> ";
  1012. $html .= "<input type='radio' name='revision' value='$rev' $c2/></td><td>";
  1013. }
  1014. if (0 == $row) { # current revision
  1015. $html .= &GetPageLinkText($id, Ts('Revision %s', $rev)) . ' ';
  1016. if ($canEdit) {
  1017. $html .= &GetEditLink($id, T('Edit')) . ' ';
  1018. }
  1019. } else {
  1020. $html .= &GetOldPageLink('browse', $id, $rev,
  1021. Ts('Revision %s', $rev)) . ' ';
  1022. if ($canEdit) {
  1023. $html .= &GetOldPageLink('edit', $id, $rev, T('Edit')) . ' ';
  1024. }
  1025. }
  1026. $html .= ". . " . $minor . &TimeToText($ts) . " ";
  1027. $html .= T('by') . ' ' . &GetAuthorLink($host, $user, $uid) . " ";
  1028. if (defined($summary) && ($summary ne "") && ($summary ne "*")) {
  1029. $summary = &QuoteHtml($summary); # Thanks Sunir! :-)
  1030. $html .= "<b>[$summary]</b> ";
  1031. }
  1032. $html .= $UseDiff ? "</tr>\n" : "<br>\n";
  1033. return $html;
  1034. }
  1035. # ==== HTML and page-oriented functions ====
  1036. sub ScriptLinkChar {
  1037. if ($SlashLinks) {
  1038. return '/';
  1039. }
  1040. return '?';
  1041. }
  1042. sub ScriptLink {
  1043. my ($action, $text) = @_;
  1044. return '<a href="' . $ScriptName . &ScriptLinkChar() . &UriEscape($action)
  1045. . "\">$text</a>";
  1046. }
  1047. sub ScriptLinkClass {
  1048. my ($action, $text, $class) = @_;
  1049. return '<a href="' . $ScriptName . &ScriptLinkChar() . &UriEscape($action)
  1050. . '" class="' . $class . "\">$text</a>";
  1051. }
  1052. sub GetPageLinkText {
  1053. my ($id, $name) = @_;
  1054. $id =~ s|^/|$MainPage/|;
  1055. if ($FreeLinks) {
  1056. $id = &FreeToNormal($id);
  1057. $name =~ s/_/ /g;
  1058. }
  1059. return &ScriptLinkClass($id, $name, 'wikipagelink');
  1060. }
  1061. sub GetPageLink {
  1062. my ($id) = @_;
  1063. return &GetPageLinkText($id, $id);
  1064. }
  1065. sub GetEditLink {
  1066. my ($id, $name) = @_;
  1067. if ($FreeLinks) {
  1068. $id = &FreeToNormal($id);
  1069. $name =~ s/_/ /g;
  1070. }
  1071. return &ScriptLinkClass("action=edit&id=$id", $name, 'wikipageedit');
  1072. }
  1073. sub GetDeleteLink {
  1074. my ($id, $name, $confirm) = @_;
  1075. if ($FreeLinks) {
  1076. $id = &FreeToNormal($id);
  1077. $name =~ s/_/ /g;
  1078. }
  1079. return &ScriptLink("action=delete&id=$id&confirm=$confirm", $name);
  1080. }
  1081. sub GetOldPageParameters {
  1082. my ($kind, $id, $revision) = @_;
  1083. $id = &FreeToNormal($id) if $FreeLinks;
  1084. return "action=$kind&id=$id&revision=$revision";
  1085. }
  1086. sub GetOldPageLink {
  1087. my ($kind, $id, $revision, $name) = @_;
  1088. $name =~ s/_/ /g if $FreeLinks;
  1089. return &ScriptLink(&GetOldPageParameters($kind, $id, $revision), $name);
  1090. }
  1091. sub GetPageOrEditAnchoredLink {
  1092. my ($id, $anchor, $name) = @_;
  1093. my (@temp, $exists);
  1094. if ($name eq "") {
  1095. $name = $id;
  1096. if ($FreeLinks) {
  1097. $name =~ s/_/ /g;
  1098. }
  1099. }
  1100. $id =~ s|^/|$MainPage/|;
  1101. if ($FreeLinks) {
  1102. $id = &FreeToNormal($id);
  1103. }
  1104. $exists = 0;
  1105. if ($UseIndex) {
  1106. if (!$IndexInit) {
  1107. @temp = &AllPagesList(); # Also initializes hash
  1108. }
  1109. $exists = 1 if ($IndexHash{$id});
  1110. } elsif (-f &GetPageFile($id)) { # Page file exists
  1111. $exists = 1;
  1112. }
  1113. if ($exists) {
  1114. $id = "$id#$anchor" if $anchor;
  1115. $name = "$name#$anchor" if $anchor && $NamedAnchors != 2;
  1116. return &GetPageLinkText($id, $name);
  1117. }
  1118. if ($FreeLinks && !$EditNameLink) {
  1119. if ($name =~ m| |) { # Not a single word
  1120. $name = "[$name]"; # Add brackets so boundaries are obvious
  1121. }
  1122. }
  1123. if ($EditNameLink) {
  1124. return &GetEditLink($id, $name);
  1125. } else {
  1126. return $name . &GetEditLink($id, '?');
  1127. }
  1128. }
  1129. sub GetPageOrEditLink {
  1130. my ($id, $name) = @_;
  1131. return &GetPageOrEditAnchoredLink($id, "", $name);
  1132. }
  1133. sub GetBackLinksSearchLink {
  1134. my ($id) = @_;
  1135. my $name = $id;
  1136. $id =~ s|.+/|/|; # Subpage match: search for just /SubName
  1137. if ($FreeLinks) {
  1138. $name =~ s/_/ /g; # Display with spaces
  1139. $id =~ s/_/+/g; # Search for url-escaped spaces
  1140. }
  1141. return &ScriptLink("back=$id", $name);
  1142. }
  1143. sub GetPrefsLink {
  1144. return &ScriptLink("action=editprefs", T('Preferences'));
  1145. }
  1146. sub GetRandomLink {
  1147. return &ScriptLink("action=random", T('Random Page'));
  1148. }
  1149. sub ScriptLinkDiff {
  1150. my ($diff, $id, $text, $rev) = @_;
  1151. $rev = "&revision=$rev" if ($rev ne "");
  1152. $diff = &GetParam("defaultdiff", 1) if ($diff == 4);
  1153. return &ScriptLink("action=browse&diff=$diff&id=$id$rev", $text);
  1154. }
  1155. sub ScriptLinkDiffRevision {
  1156. my ($diff, $id, $rev, $text) = @_;
  1157. $rev = "&diffrevision=$rev" if ($rev ne "");
  1158. $diff = &GetParam("defaultdiff", 1) if ($diff == 4);
  1159. return &ScriptLink("action=browse&diff=$diff&id=$id$rev", $text);
  1160. }
  1161. sub GetUploadLink {
  1162. return &ScriptLink('action=upload', T('Upload'));
  1163. }
  1164. sub ScriptLinkTitle {
  1165. my ($action, $text, $title) = @_;
  1166. if ($FreeLinks) {
  1167. $action =~ s/ /_/g;
  1168. }
  1169. return '<a href="' . $ScriptName . &ScriptLinkChar() . &UriEscape($action)
  1170. . "\" title=\"$title\">$text</a>";
  1171. }
  1172. sub GetAuthorLink {
  1173. my ($host, $userName, $uid) = @_;
  1174. my ($html, $title, $userNameShow);
  1175. $userNameShow = $userName;
  1176. if ($FreeLinks) {
  1177. $userName =~ s/ /_/g;
  1178. $userNameShow =~ s/_/ /g;
  1179. }
  1180. if (&ValidId($userName) ne "") { # Invalid under current rules
  1181. $userName = ""; # Just pretend it isn't there.
  1182. }
  1183. if (($uid > 0) && ($userName ne "")) {
  1184. $html = &ScriptLinkTitle($userName, $userNameShow,
  1185. Ts('ID %s', $uid) . ' ' . Ts('from %s', $host));
  1186. } else {
  1187. $html = $host;
  1188. }
  1189. return $html;
  1190. }
  1191. sub GetHistoryLink {
  1192. my ($id, $text) = @_;
  1193. if ($FreeLinks) {
  1194. $id =~ s/ /_/g;
  1195. }
  1196. return &ScriptLink("action=history&id=$id", $text);
  1197. }
  1198. sub GetHeader {
  1199. my ($id, $title, $oldId, $backlinks) = @_;
  1200. my $header = "";
  1201. my $logoImage = "";
  1202. my $result = "";
  1203. my $embed = &GetParam('embed', $EmbedWiki);
  1204. my $altText = T('[Home]');
  1205. $result = &GetHttpHeader('');
  1206. if ($FreeLinks) {
  1207. $title =~ s/_/ /g; # Display as spaces
  1208. }
  1209. $result .= &GetHtmlHeader("$SiteName: $title");
  1210. return $result if ($embed);
  1211. $result .= '<div class=wikiheader>';
  1212. if ($oldId ne '') {
  1213. $result .= $q->h3('(' . Ts('redirected from %s',
  1214. &GetEditLink($oldId, &QuoteHtml($oldId)), 1) . ')');
  1215. }
  1216. if ((!$embed) && ($LogoUrl ne "")) {
  1217. $logoImage = "img src=\"$LogoUrl\" alt=\"$altText\" border=0";
  1218. if (!$LogoLeft) {
  1219. $logoImage .= " align=\"right\"";
  1220. }
  1221. $header = &ScriptLink($HomePage, "<$logoImage>");
  1222. }
  1223. if ($id and $backlinks) {
  1224. $result .= $q->h1($header . &GetBackLinksSearchLink($id));
  1225. } else {
  1226. $result .= $q->h1($header . $title);
  1227. }
  1228. if (&GetParam("toplinkbar", 1)) {
  1229. $result .= &GetGotoBar($id) . "<hr class=wikilineheader>";
  1230. }
  1231. $result .= '</div>';
  1232. return $result;
  1233. }
  1234. sub GetHttpHeader {
  1235. my ($type) = @_;
  1236. my $cookie;
  1237. $type = 'text/html' if ($type eq '');
  1238. if (defined($SetCookie{'id'})) {
  1239. $cookie = "$CookieName="
  1240. . "rev&" . $SetCookie{'rev'}
  1241. . "&id&" . $SetCookie{'id'}
  1242. . "&randkey&" . $SetCookie{'randkey'};
  1243. $cookie .= ";expires=Fri, 08-Sep-2013 19:48:23 GMT";
  1244. if ($HttpCharset ne '') {
  1245. return $q->header(-cookie=>$cookie,
  1246. -type=>"$type; charset=$HttpCharset");
  1247. }
  1248. return $q->header(-cookie=>$cookie);
  1249. }
  1250. if ($HttpCharset ne '') {
  1251. return $q->header(-type=>"$type; charset=$HttpCharset");
  1252. }
  1253. return $q->header(-type=>$type);
  1254. }
  1255. sub GetHtmlHeader {
  1256. my ($title) = @_;
  1257. my ($dtd, $html, $bodyExtra, $stylesheet);
  1258. $html = '';
  1259. $dtd = '-//IETF//DTD HTML//EN';
  1260. $html = qq(<!DOCTYPE HTML PUBLIC "$dtd">\n);
  1261. $title = $q->escapeHTML($title);
  1262. $html .= "<HTML><HEAD><TITLE>$title</TITLE>\n";
  1263. if ($FavIcon ne '') {
  1264. $html .= '<LINK REL="SHORTCUT ICON" HREF="' . $FavIcon . '">'
  1265. }
  1266. if ($MetaKeywords) {
  1267. my $keywords = $OpenPageName;
  1268. $keywords =~ s/([a-z])([A-Z])/$1, $2/g;
  1269. $html .= "<META NAME='KEYWORDS' CONTENT='$keywords'/>\n" if $keywords;
  1270. }
  1271. # we don't want robots indexing our history or other admin pages
  1272. my $action = lc(&GetParam('action', ''));
  1273. unless (!$action or $action eq "rc" or $action eq "index") {
  1274. $html .= "<META NAME='robots' CONTENT='noindex,nofollow'>\n";
  1275. }
  1276. if ($SiteBase ne "") {
  1277. $html .= qq(<BASE HREF="$SiteBase">\n);
  1278. }
  1279. $stylesheet = &GetParam('stylesheet', $StyleSheet);
  1280. $stylesheet = $StyleSheet if ($stylesheet eq '');
  1281. $stylesheet = '' if ($stylesheet eq '*'); # Allow removing override
  1282. if ($stylesheet ne '') {
  1283. $html .= qq(<LINK REL="stylesheet" HREF="$stylesheet">\n);
  1284. }
  1285. $html .= $UserHeader;
  1286. $bodyExtra = '';
  1287. if ($UserBody ne '') {
  1288. $bodyExtra = ' ' . $UserBody;
  1289. }
  1290. if ($BGColor ne '') {
  1291. $bodyExtra .= qq( BGCOLOR="$BGColor");
  1292. }
  1293. $html .= "</HEAD><BODY$bodyExtra>\n";
  1294. return $html;
  1295. }
  1296. sub GetFooterText {
  1297. my ($id, $rev) = @_;
  1298. my $result;
  1299. if (&GetParam('embed', $EmbedWiki)) {
  1300. return $q->end_html;
  1301. }
  1302. $result = '<div class=wikifooter>';
  1303. $result .= "<hr class=wikilinefooter>\n";
  1304. $result .= &GetFormStart();
  1305. $result .= &GetGotoBar($id);
  1306. if (&UserCanEdit($id, 0)) {
  1307. if ($rev ne '') {
  1308. $result .= &GetOldPageLink('edit', $id, $rev,
  1309. Ts('Edit revision %s of this page', $rev));
  1310. } else {
  1311. $result .= &GetEditLink($id, T('Edit text of this page'));
  1312. }
  1313. } else {
  1314. $result .= T('This page is read-only');
  1315. }
  1316. $result .= ' | ';
  1317. $result .= &GetHistoryLink($id, T('View other revisions'));
  1318. if ($rev ne '') {
  1319. $result .= ' | ';
  1320. $result .= &GetPageLinkText($id, T('View current revision'));
  1321. }
  1322. if ($UseMetaWiki) {
  1323. $result .= ' | <a href="http://sunir.org/apps/meta.pl?' . &UriEscape($id) . '">'
  1324. . T('Search MetaWiki') . '</a>';
  1325. }
  1326. if ($Section{'revision'} > 0) {
  1327. $result .= '<br>';
  1328. if ($rev eq '') { # Only for most current rev
  1329. $result .= T('Last edited');
  1330. } else {
  1331. $result .= T('Edited');
  1332. }
  1333. $result .= ' ' . &TimeToText($Section{ts});
  1334. if ($AuthorFooter) {
  1335. $result .= ' ' . Ts('by %s', &GetAuthorLink($Section{'host'},
  1336. $Section{'username'}, $Section{'id'}), 1);
  1337. }
  1338. }
  1339. if ($UseDiff) {
  1340. $result .= ' ' . &ScriptLinkDiff(4, $id, T('(diff)'), $rev);
  1341. }
  1342. $result .= '<br>' . &GetSearchForm();
  1343. if ($AdminBar && &UserIsAdmin()) {
  1344. $result .= '<br>' . &GetAdminBar($id);
  1345. }
  1346. if ($DataDir =~ m|/tmp/|) {
  1347. $result .= '<br><b>' . T('Warning') . ':</b> '
  1348. . Ts('Database is stored in temporary directory %s',
  1349. $DataDir) . '<br>';
  1350. }
  1351. if ($ConfigError ne '') {
  1352. $result .= '<br><b>' . T('Config file error:') . '</b> '
  1353. . $ConfigError . '<br>';
  1354. }
  1355. $result .= $q->endform;
  1356. if ($FooterNote ne '') {
  1357. $result .= T($FooterNote);
  1358. }
  1359. $result .= '</div>';
  1360. $result .= &GetMinimumFooter();
  1361. return $result;
  1362. }
  1363. sub GetCommonFooter {
  1364. my ($html);
  1365. $html = '<div class=wikifooter>' . '<hr class=wikilinefooter>'
  1366. . &GetFormStart() . &GetGotoBar('')
  1367. . &GetSearchForm() . $q->endform;
  1368. if ($FooterNote ne '') {
  1369. $html .= T($FooterNote);
  1370. }
  1371. $html .= '</div>' . $q->end_html;
  1372. return $html;
  1373. }
  1374. sub GetMinimumFooter {
  1375. return $q->end_html;
  1376. }
  1377. sub GetFormStart {
  1378. return $q->startform("POST", "$ScriptName",
  1379. "application/x-www-form-urlencoded");
  1380. }
  1381. sub GetGotoBar {
  1382. my ($id) = @_;
  1383. my ($main, $bartext);
  1384. $bartext = &GetPageLink($HomePage);
  1385. if ($id =~ m|/|) {
  1386. $main = $id;
  1387. $main =~ s|/.*||; # Only the main page name (remove subpage)
  1388. $bartext .= " | " . &GetPageLink($main);
  1389. }
  1390. $bartext .= " | " . &GetPageLink($RCName);
  1391. $bartext .= " | " . &GetPrefsLink();
  1392. if ($UseUpload && &UserCanUpload()) {
  1393. $bartext .= " | " . &GetUploadLink();
  1394. }
  1395. if (&GetParam("linkrandom", 0)) {
  1396. $bartext .= " | " . &GetRandomLink();
  1397. }
  1398. if ($UserGotoBar ne '') {
  1399. $bartext .= " | " . $UserGotoBar;
  1400. }
  1401. $bartext .= "<br>\n";
  1402. return $bartext;
  1403. }
  1404. # Admin bar contributed by ElMoro (with some changes)
  1405. sub GetPageLockLink {
  1406. my ($id, $status, $name) = @_;
  1407. if ($FreeLinks) {
  1408. $id = &FreeToNormal($id);
  1409. }
  1410. return &ScriptLink("action=pagelock&set=$status&id=$id", $name);
  1411. }
  1412. sub GetAdminBar {
  1413. my ($id) = @_;
  1414. my ($result);
  1415. $result = T('Administration') . ': ';
  1416. if (-f &GetLockedPageFile($id)) {
  1417. $result .= &GetPageLockLink($id, 0, T('Unlock page'));
  1418. }
  1419. else {
  1420. $result .= &GetPageLockLink($id, 1, T('Lock page'));
  1421. }
  1422. $result .= " | " . &GetDeleteLink($id, T('Delete this page'), 0);
  1423. $result .= " | " . &ScriptLink("action=editbanned", T("Edit Banned List"));
  1424. $result .= " | " . &ScriptLink("action=maintain", T("Run Maintenance"));
  1425. $result .= " | " . &ScriptLink("action=editlinks", T("Edit/Rename pages"));
  1426. if (-f "$DataDir/noedit") {
  1427. $result .= " | " . &ScriptLink("action=editlock&set=0", T("Unlock site"));
  1428. } else {
  1429. $result .= " | " . &ScriptLink("action=editlock&set=1", T("Lock site"));
  1430. }
  1431. return $result;
  1432. }
  1433. sub GetSearchForm {
  1434. my ($result);
  1435. $result = T('Search:') . ' ' . $q->textfield(-name=>'search', -size=>20);
  1436. if ($SearchButton) {
  1437. $result .= $q->submit('dosearch', T('Go!'));
  1438. } else {
  1439. $result .= &GetHiddenValue("dosearch", 1);
  1440. }
  1441. return $result;
  1442. }
  1443. sub GetRedirectPage {
  1444. my ($newid, $name, $isEdit) = @_;
  1445. my ($url, $html);
  1446. my ($nameLink);
  1447. # Normally get URL from script, but allow override.
  1448. $FullUrl = $q->url(-full=>1) if ($FullUrl eq "");
  1449. $url = $FullUrl . &ScriptLinkChar() . &UriEscape($newid);
  1450. $nameLink = "<a href=\"$url\">$name</a>";
  1451. if ($RedirType < 3) {
  1452. if ($RedirType == 1) { # Use CGI.pm
  1453. # NOTE: do NOT use -method (does not work with old CGI.pm versions)
  1454. # Thanks to Daniel Neri for fixing this problem.
  1455. $html = $q->redirect(-uri=>$url);
  1456. } else { # Minimal header
  1457. $html = "Status: 302 Moved\n";
  1458. $html .= "Location: $url\n";
  1459. $html .= "Content-Type: text/html\n"; # Needed for browser failure
  1460. $html .= "\n";
  1461. }
  1462. $html .= "\n" . Ts('Your browser should go to the %s page.', $newid);
  1463. $html .= ' ' . Ts('If it does not, click %s to continue.', $nameLink);
  1464. } else {
  1465. if ($isEdit) {
  1466. $html = &GetHeader('', T('Thanks for editing...'), '');
  1467. $html .= Ts('Thank you for editing %s.', $nameLink);
  1468. } else {
  1469. $html = &GetHeader('', T('Link to another page...'), '');
  1470. }
  1471. $html .= "\n<p>";
  1472. $html .= Ts('Follow the %s link to continue.', $nameLink);
  1473. $html .= &GetMinimumFooter();
  1474. }
  1475. return $html;
  1476. }
  1477. # ==== Common wiki markup ====
  1478. sub RestoreSavedText {
  1479. my ($text) = @_;
  1480. 1 while $text =~ s/$FS(\d+)$FS/$SaveUrl{$1}/ge; # Restore saved text
  1481. return $text;
  1482. }
  1483. sub RemoveFS {
  1484. my ($text) = @_;
  1485. # Note: must remove all $FS, and $FS may be multi-byte/char separator
  1486. $text =~ s/($FS)+(\d)/$2/g;
  1487. return $text;
  1488. }
  1489. sub WikiToHTML {
  1490. my ($pageText) = @_;
  1491. $TableMode = 0;
  1492. %SaveUrl = ();
  1493. %SaveNumUrl = ();
  1494. $SaveUrlIndex = 0;
  1495. $SaveNumUrlIndex = 0;
  1496. $pageText = &RemoveFS($pageText);
  1497. if ($RawHtml) {
  1498. $pageText =~ s/<html>((.|\n)*?)<\/html>/&StoreRaw($1)/ige;
  1499. }
  1500. $pageText = &QuoteHtml($pageText);
  1501. $pageText =~ s/\\ *\r?\n/ /g; # Join lines with backslash at end
  1502. if ($ParseParas) {
  1503. # Note: The following 3 rules may span paragraphs, so they are
  1504. # copied from CommonMarkup
  1505. $pageText =~
  1506. s/\&lt;nowiki\&gt;((.|\n)*?)\&lt;\/nowiki\&gt;/&StoreRaw($1)/ige;
  1507. $pageText =~
  1508. s/\&lt;pre\&gt;((.|\n)*?)\&lt;\/pre\&gt;/&StorePre($1, "pre")/ige;
  1509. $pageText =~
  1510. s/\&lt;code\&gt;((.|\n)*?)\&lt;\/code\&gt;/&StorePre($1, "code")/ige;
  1511. $pageText =~ s/((.|\n)+?\n)\s*(\n|$)/&ParseParagraph($1)/geo;
  1512. $pageText =~ s/(.*)<\/p>(.+)$/$1.&ParseParagraph($2)/seo;
  1513. } else {
  1514. $pageText = &CommonMarkup($pageText, 1, 0); # Multi-line markup
  1515. $pageText = &WikiLinesToHtml($pageText); # Line-oriented markup
  1516. }
  1517. while (@HeadingNumbers) {
  1518. pop @HeadingNumbers;
  1519. $TableOfContents .= "</dd></dl>\n\n";
  1520. }
  1521. $pageText =~ s/&lt;toc&gt;/$TableOfContents/gi;
  1522. if ($LateRules ne '') {
  1523. $pageText = &EvalLocalRules($LateRules, $pageText, 0);
  1524. }
  1525. return &RestoreSavedText($pageText);
  1526. }
  1527. sub CommonMarkup {
  1528. my ($text, $useImage, $doLines) = @_;
  1529. local $_ = $text;
  1530. if ($doLines < 2) { # 2 = do line-oriented only
  1531. # The <nowiki> tag stores text with no markup (except quoting HTML)
  1532. s/\&lt;nowiki\&gt;((.|\n)*?)\&lt;\/nowiki\&gt;/&StoreRaw($1)/ige;
  1533. # The <pre> tag wraps the stored text with the HTML <pre> tag
  1534. s/\&lt;pre\&gt;((.|\n)*?)\&lt;\/pre\&gt;/&StorePre($1, "pre")/ige;
  1535. s/\&lt;code\&gt;((.|\n)*?)\&lt;\/code\&gt;/&StorePre($1, "code")/ige;
  1536. if ($EarlyRules ne '') {
  1537. $_ = &EvalLocalRules($EarlyRules, $_, !$useImage);
  1538. }
  1539. s/\[\#(\w+)\]/&StoreHref(" name=\"$1\"")/ge if $NamedAnchors;
  1540. if ($HtmlTags) {
  1541. my ($t);
  1542. foreach $t (@HtmlPairs) {
  1543. s/\&lt;$t(\s[^<>]+?)?\&gt;(.*?)\&lt;\/$t\&gt;/<$t$1>$2<\/$t>/gis;
  1544. }
  1545. foreach $t (@HtmlSingle) {
  1546. s/\&lt;$t(\s[^<>]+?)?\&gt;/<$t$1>/gi;
  1547. }
  1548. } else {
  1549. # Note that these tags are restricted to a single line
  1550. s/\&lt;b\&gt;(.*?)\&lt;\/b\&gt;/<b>$1<\/b>/gi;
  1551. s/\&lt;i\&gt;(.*?)\&lt;\/i\&gt;/<i>$1<\/i>/gi;
  1552. s/\&lt;strong\&gt;(.*?)\&lt;\/strong\&gt;/<strong>$1<\/strong>/gi;
  1553. s/\&lt;em\&gt;(.*?)\&lt;\/em\&gt;/<em>$1<\/em>/gi;
  1554. }
  1555. s/\&lt;tt\&gt;(.*?)\&lt;\/tt\&gt;/<tt>$1<\/tt>/gis; # <tt> (MeatBall)
  1556. s/\&lt;br\&gt;/<br>/gi; # Allow simple line break anywhere
  1557. if ($HtmlLinks) {
  1558. s/\&lt;A(\s[^<>]+?)\&gt;(.*?)\&lt;\/a\&gt;/&StoreHref($1, $2)/gise;
  1559. }
  1560. if ($FreeLinks) {
  1561. # Consider: should local free-link descriptions be conditional?
  1562. # Also, consider that one could write [[Bad Page|Good Page]]?
  1563. s/\[\[$FreeLinkPattern\|([^\]]+)\]\]/&StorePageOrEditLink($1, $2)/geo;
  1564. s/\[\[$FreeLinkPattern\]\]/&StorePageOrEditLink($1, "")/geo;
  1565. }
  1566. if ($BracketText) { # Links like [URL text of link]
  1567. s/\[$UrlPattern\s+([^\]]+?)\]/&StoreBracketUrl($1, $2, $useImage)/geos;
  1568. s/\[$InterLinkPattern\s+([^\]]+?)\]/&StoreBracketInterPage($1, $2,
  1569. $useImage)/geos;
  1570. if ($WikiLinks && $BracketWiki) { # Local bracket-links
  1571. s/\[$LinkPattern\s+([^\]]+?)\]/&StoreBracketLink($1, $2)/geos;
  1572. s/\[$AnchoredLinkPattern\s+([^\]]+?)\]/&StoreBracketAnchoredLink($1,
  1573. $2, $3)/geos if $NamedAnchors;
  1574. }
  1575. }
  1576. s/\[$UrlPattern\]/&StoreBracketUrl($1, "", 0)/geo;
  1577. s/\[$InterLinkPattern\]/&StoreBracketInterPage($1, "", 0)/geo;
  1578. s/\b$UrlPattern/&StoreUrl($1, $useImage)/geo;
  1579. s/\b$InterLinkPattern/&StoreInterPage($1, $useImage)/geo;
  1580. if ($UseUpload) {
  1581. s/$UploadPattern/&StoreUpload($1)/geo;
  1582. }
  1583. if ($WikiLinks) {
  1584. s/$AnchoredLinkPattern/&StoreRaw(&GetPageOrEditAnchoredLink($1,
  1585. $2, ""))/geo if $NamedAnchors;
  1586. # CAA: Putting \b in front of $LinkPattern breaks /SubPage links
  1587. # (subpage links without the main page)
  1588. s/$LinkPattern/&GetPageOrEditLink($1, "")/geo;
  1589. }
  1590. s/\b$RFCPattern/&StoreRFC($1)/geo;
  1591. s/\b$ISBNPattern/&StoreISBN($1)/geo;
  1592. if ($ThinLine) {
  1593. if ($OldThinLine) { # Backwards compatible, conflicts with headers
  1594. s/====+/<hr noshade class=wikiline size=2>/g;
  1595. } else { # New behavior--no conflict
  1596. s/------+/<hr noshade class=wikiline size=2>/g;
  1597. }
  1598. s/----+/<hr noshade class=wikiline size=1>/g;
  1599. } else {
  1600. s/----+/<hr class=wikiline>/g;
  1601. }
  1602. }
  1603. if ($doLines) { # 0 = no line-oriented, 1 or 2 = do line-oriented
  1604. # The quote markup patterns avoid overlapping tags (with 5 quotes)
  1605. # by matching the inner quotes for the strong pattern.
  1606. s/('*)'''(.*?)'''/$1<strong>$2<\/strong>/g;
  1607. s/''(.*?)''/<em>$1<\/em>/g;
  1608. if ($UseHeadings) {
  1609. s/(^|\n)\s*(\=+)\s+([^\n]+)\s+\=+/&WikiHeading($1, $2, $3)/geo;
  1610. }
  1611. if ($TableMode) {
  1612. s/((\|\|)+)/"<\/TD><TD COLSPAN=\"" . (length($1)\/2) . "\">"/ge;
  1613. }
  1614. }
  1615. return $_;
  1616. }
  1617. sub EmptyCellsToNbsp {
  1618. my ($row) = @_;
  1619. $row =~ s/(?<=\|\|)\s+(?=\|\|)/&nbsp;/g;
  1620. $row =~ s/^\s+(?=\|\|)/&nbsp;/;
  1621. $row =~ s/(?<=\|\|)\s+$/&nbsp;/;
  1622. return $row;
  1623. }
  1624. sub WikiLinesToHtml {
  1625. my ($pageText) = @_;
  1626. my ($pageHtml, @htmlStack, $code, $codeAttributes, $depth, $oldCode);
  1627. @htmlStack = ();
  1628. $depth = 0;
  1629. $pageHtml = "";
  1630. foreach (split(/\n/, $pageText)) { # Process lines one-at-a-time
  1631. $code = '';
  1632. $codeAttributes = '';
  1633. $TableMode = 0;
  1634. $_ .= "\n";
  1635. if (s/^(\;+)([^:]+\:?)\:/<dt>$2<dd>/) {
  1636. $code = "DL";
  1637. $depth = length $1;
  1638. } elsif (s/^(\:+)/<dt><dd>/) {
  1639. $code = "DL";
  1640. $depth = length $1;
  1641. } elsif (s/^(\*+)/<li>/) {
  1642. $code = "UL";
  1643. $depth = length $1;
  1644. } elsif (s/^(\#+)/<li>/) {
  1645. $code = "OL";
  1646. $depth = length $1;
  1647. } elsif ($TableSyntax &&
  1648. s/^((\|\|)+)(.*)\|\|\s*$/"<TR VALIGN='CENTER' "
  1649. . "ALIGN='CENTER'><TD colspan='"
  1650. . (length($1)\/2) . "'>" . EmptyCellsToNbsp($3) . "<\/TD><\/TR>\n"/e) {
  1651. $code = 'TABLE';
  1652. $codeAttributes = "BORDER='1'";
  1653. $TableMode = 1;
  1654. $depth = 1;
  1655. } elsif (/^[ \t].*\S/) {
  1656. $code = "PRE";
  1657. $depth = 1;
  1658. } else {
  1659. $depth = 0;
  1660. }
  1661. while (@htmlStack > $depth) { # Close tags as needed
  1662. $pageHtml .= "</" . pop(@htmlStack) . ">\n";
  1663. }
  1664. if ($depth > 0) {
  1665. $depth = $IndentLimit if ($depth > $IndentLimit);
  1666. if (@htmlStack) { # Non-empty stack
  1667. $oldCode = pop(@htmlStack);
  1668. if ($oldCode ne $code) {
  1669. $pageHtml .= "</$oldCode><$code>\n";
  1670. }
  1671. push(@htmlStack, $code);
  1672. }
  1673. while (@htmlStack < $depth) {
  1674. push(@htmlStack, $code);
  1675. $pageHtml .= "<$code $codeAttributes>\n";
  1676. }
  1677. }
  1678. if (!$ParseParas) {
  1679. s/^\s*$/<p>\n/; # Blank lines become <p> tags
  1680. }
  1681. $pageHtml .= &CommonMarkup($_, 1, 2); # Line-oriented common markup
  1682. }
  1683. while (@htmlStack > 0) { # Clear stack
  1684. $pageHtml .= "</" . pop(@htmlStack) . ">\n";
  1685. }
  1686. return $pageHtml;
  1687. }
  1688. sub EvalLocalRules {
  1689. my ($rules, $origText, $isDiff) = @_;
  1690. my ($text, $reportError, $errorText);
  1691. $text = $origText;
  1692. $reportError = 1;
  1693. # Basic idea: the $rules should change $text, possibly with different
  1694. # behavior if $isDiff is true (no images or color changes?)
  1695. # Note: for fun, the $rules could also change $reportError and $origText
  1696. if (!eval $rules) {
  1697. $errorText = $@;
  1698. if ($errorText eq '') {
  1699. # Search for "Unknown Error" for the reason the next line is commented
  1700. # $errorText = T('Unknown Error (no error text)');
  1701. }
  1702. if ($errorText ne '') {
  1703. $text = $origText; # Consider: should partial results be kept?
  1704. if ($reportError) {
  1705. $text .= '<hr><b>' . T('Local rule error:') . '</b><br>'
  1706. . &QuoteHtml($errorText);
  1707. }
  1708. }
  1709. }
  1710. return $text;
  1711. }
  1712. sub UriEscape {
  1713. my ($uri) = @_;
  1714. $uri =~ s/([\x00-\x1f\x7f-\xff])/sprintf("%%%02X", ord($1))/ge;
  1715. $uri =~ s/\&/\&amp;/g;
  1716. return $uri;
  1717. }
  1718. sub ParseParagraph {
  1719. my ($text) = @_;
  1720. $text = &CommonMarkup($text, 1, 0); # Multi-line markup
  1721. $text = &WikiLinesToHtml($text); # Line-oriented markup
  1722. return "<p>$text</p>\n";
  1723. }
  1724. sub StoreInterPage {
  1725. my ($id, $useImage) = @_;
  1726. my ($link, $extra);
  1727. ($link, $extra) = &InterPageLink($id, $useImage);
  1728. # Next line ensures no empty links are stored
  1729. $link = &StoreRaw($link) if ($link ne "");
  1730. return $link . $extra;
  1731. }
  1732. sub InterPageLink {
  1733. my ($id, $useImage) = @_;
  1734. my ($name, $site, $remotePage, $url, $punct);
  1735. ($id, $punct) = &SplitUrlPunct($id);
  1736. $name = $id;
  1737. ($site, $remotePage) = split(/:/, $id, 2);
  1738. $url = &GetSiteUrl($site);
  1739. return ("", $id . $punct) if ($url eq "");
  1740. $remotePage =~ s/&amp;/&/g; # Unquote common URL HTML
  1741. $url .= $remotePage;
  1742. return (&UrlLinkOrImage($url, $name, $useImage), $punct);
  1743. }
  1744. sub StoreBracketInterPage {
  1745. my ($id, $text, $useImage) = @_;
  1746. my ($site, $remotePage, $url, $index);
  1747. ($site, $remotePage) = split(/:/, $id, 2);
  1748. $remotePage =~ s/&amp;/&/g; # Unquote common URL HTML
  1749. $url = &GetSiteUrl($site);
  1750. if ($text ne "") {
  1751. return "[$id $text]" if ($url eq "");
  1752. } else {
  1753. return "[$id]" if ($url eq "");
  1754. $text = &GetBracketUrlIndex($id);
  1755. }
  1756. $url .= $remotePage;
  1757. if ($BracketImg && $useImage && &ImageAllowed($text)) {
  1758. $text = "<img src=\"$text\">";
  1759. } else {
  1760. $text = "[$text]";
  1761. }
  1762. return &StoreRaw("<a href=\"$url\">$text</a>");
  1763. }
  1764. sub GetBracketUrlIndex {
  1765. my ($id) = @_;
  1766. my ($index, $key);
  1767. # Consider plain array?
  1768. if ($SaveNumUrl{$id} > 0) {
  1769. return $SaveNumUrl{$id};
  1770. }
  1771. $SaveNumUrlIndex++; # Start with 1
  1772. $SaveNumUrl{$id} = $SaveNumUrlIndex;
  1773. return $SaveNumUrlIndex;
  1774. }
  1775. sub GetSiteUrl {
  1776. my ($site) = @_;
  1777. my ($data, $status);
  1778. if (!$InterSiteInit) {
  1779. ($status, $data) = &ReadFile($InterFile);
  1780. if ($status) {
  1781. %InterSite = split(/\s+/, $data); # Consider defensive code
  1782. }
  1783. # Check for definitions to allow file to override automatic settings
  1784. if (!defined($InterSite{'LocalWiki'})) {
  1785. $InterSite{'LocalWiki'} = $ScriptName . &ScriptLinkChar();
  1786. }
  1787. if (!defined($InterSite{'Local'})) {
  1788. $InterSite{'Local'} = $ScriptName . &ScriptLinkChar();
  1789. }
  1790. $InterSiteInit = 1; # Init only once per request
  1791. }
  1792. return $InterSite{$site} if (defined($InterSite{$site}));
  1793. return '';
  1794. }
  1795. sub StoreRaw {
  1796. my ($html) = @_;
  1797. $SaveUrl{$SaveUrlIndex} = $html;
  1798. return $FS . $SaveUrlIndex++ . $FS;
  1799. }
  1800. sub StorePre {
  1801. my ($html, $tag) = @_;
  1802. return &StoreRaw("<$tag>" . $html . "</$tag>");
  1803. }
  1804. sub StoreHref {
  1805. my ($anchor, $text) = @_;
  1806. return "<a" . &StoreRaw($anchor) . ">$text</a>";
  1807. }
  1808. sub StoreUrl {
  1809. my ($name, $useImage) = @_;
  1810. my ($link, $extra);
  1811. ($link, $extra) = &UrlLink($name, $useImage);
  1812. # Next line ensures no empty links are stored
  1813. $link = &StoreRaw($link) if ($link ne "");
  1814. return $link . $extra;
  1815. }
  1816. sub UrlLink {
  1817. my ($rawname, $useImage) = @_;
  1818. my ($name, $punct);
  1819. ($name, $punct) = &SplitUrlPunct($rawname);
  1820. if ($LimitFileUrl && ($NetworkFile && $name =~ m|^file:|)) {
  1821. # Only do remote file:// links. No file:///c|/windows.
  1822. if ($name =~ m|^file://[^/]|) {
  1823. return ("<a href=\"$name\">$name</a>", $punct);
  1824. }
  1825. return ($rawname, '');
  1826. }
  1827. return (&UrlLinkOrImage($name, $name, $useImage), $punct);
  1828. }
  1829. sub UrlLinkOrImage {
  1830. my ($url, $name, $useImage) = @_;
  1831. # Restricted image URLs so that mailto:foo@bar.gif is not an image
  1832. if ($useImage && &ImageAllowed($url)) {
  1833. return "<img src=\"$url\">";
  1834. }
  1835. return "<a href=\"$url\">$name</a>";
  1836. }
  1837. sub ImageAllowed {
  1838. my ($url) = @_;
  1839. my ($site, $imagePrefixes);
  1840. $imagePrefixes = 'http:|https:|ftp:';
  1841. $imagePrefixes .= '|file:' if (!$LimitFileUrl);
  1842. return 0 unless ($url =~ /^($imagePrefixes).+\.$ImageExtensions$/i);
  1843. return 0 if ($url =~ /"/); # No HTML-breaking quotes allowed
  1844. return 1 if (@ImageSites < 1); # Most common case: () means all allowed
  1845. return 0 if ($ImageSites[0] eq 'none'); # Special case: none allowed
  1846. foreach $site (@ImageSites) {
  1847. return 1 if ($site eq substr($url, 0, length($site))); # Match prefix
  1848. }
  1849. return 0;
  1850. }
  1851. sub StoreBracketUrl {
  1852. my ($url, $text, $useImage) = @_;
  1853. if ($text eq "") {
  1854. $text = &GetBracketUrlIndex($url);
  1855. } elsif ($text =~ /^$InterLinkPattern$/) {
  1856. my @interlink = split(/:/, $text, 2);
  1857. $text = &GetSiteUrl($interlink[0]) . $interlink[1];
  1858. }
  1859. if ($BracketImg && $useImage && &ImageAllowed($text)) {
  1860. $text = "<img src=\"$text\">";
  1861. } else {
  1862. $text = "[$text]";
  1863. }
  1864. return &StoreRaw("<a href=\"$url\">$text</a>");
  1865. }
  1866. sub StoreBracketLink {
  1867. my ($name, $text) = @_;
  1868. return &StoreRaw(&GetPageLinkText($name, "[$text]"));
  1869. }
  1870. sub StoreBracketAnchoredLink {
  1871. my ($name, $anchor, $text) = @_;
  1872. return &StoreRaw(&GetPageLinkText("$name#$anchor", "[$text]"));
  1873. }
  1874. sub StorePageOrEditLink {
  1875. my ($page, $name) = @_;
  1876. if ($FreeLinks) {
  1877. $page =~ s/^\s+//; # Trim extra spaces
  1878. $page =~ s/\s+$//;
  1879. $page =~ s|\s*/\s*|/|; # ...also before/after subpages
  1880. }
  1881. $name =~ s/^\s+//;
  1882. $name =~ s/\s+$//;
  1883. return &StoreRaw(&GetPageOrEditLink($page, $name));
  1884. }
  1885. sub StoreRFC {
  1886. my ($num) = @_;
  1887. return &StoreRaw(&RFCLink($num));
  1888. }
  1889. sub RFCLink {
  1890. my ($num) = @_;
  1891. return "<a href=\"http://www.faqs.org/rfcs/rfc${num}.html\">RFC $num</a>";
  1892. }
  1893. sub StoreUpload {
  1894. my ($url) = @_;
  1895. return &StoreRaw(&UploadLink($url));
  1896. }
  1897. sub UploadLink {
  1898. my ($filename) = @_;
  1899. my ($html, $url);
  1900. return $filename if ($UploadUrl eq ''); # No bad links if misconfigured
  1901. $UploadUrl .= '/' if (substr($UploadUrl, -1, 1) ne '/'); # End with /
  1902. $url = $UploadUrl . $filename;
  1903. $html = '<a href="' . $url . '">';
  1904. if (&ImageAllowed($url)) {
  1905. $html .= '<img src="' . $url . '" alt="upload:' . $filename . '">';
  1906. } else {
  1907. $html .= 'upload:' . $filename;
  1908. }
  1909. $html .= '</a>';
  1910. return $html;
  1911. }
  1912. sub StoreISBN {
  1913. my ($num) = @_;
  1914. return &StoreRaw(&ISBNLink($num));
  1915. }
  1916. sub ISBNALink {
  1917. my ($num, $pre, $post, $text) = @_;
  1918. return '<a href="' . $pre . $num . $post . '">' . $text . '</a>';
  1919. }
  1920. sub ISBNLink {
  1921. my ($rawnum) = @_;
  1922. my ($rawprint, $html, $num, $numSites, $i);
  1923. $num = $rawnum;
  1924. $rawprint = $rawnum;
  1925. $rawprint =~ s/ +$//;
  1926. $num =~ s/[- ]//g;
  1927. $numSites = scalar @IsbnNames; # Number of entries
  1928. if ((length($num) != 10) || ($numSites < 1)) {
  1929. return "ISBN $rawnum";
  1930. }
  1931. $html = &ISBNALink($num, $IsbnPre[0], $IsbnPost[0], 'ISBN ' . $rawprint);
  1932. if ($numSites > 1) {
  1933. $html .= ' (';
  1934. $i = 1;
  1935. while ($i < $numSites) {
  1936. $html .= &ISBNALink($num, $IsbnPre[$i], $IsbnPost[$i], $IsbnNames[$i]);
  1937. if ($i < ($numSites - 1)) { # Not the last site
  1938. $html .= ', ';
  1939. }
  1940. $i++;
  1941. }
  1942. $html .= ')';
  1943. }
  1944. $html .= " " if ($rawnum =~ / $/); # Add space if old ISBN had space.
  1945. return $html;
  1946. }
  1947. sub SplitUrlPunct {
  1948. my ($url) = @_;
  1949. my ($punct);
  1950. if ($url =~ s/\"\"$//) {
  1951. return ($url, ""); # Delete double-quote delimiters here
  1952. }
  1953. $punct = "";
  1954. if ($NewFS) {
  1955. ($punct) = ($url =~ /([^a-zA-Z0-9\/\x80-\xff]+)$/);
  1956. $url =~ s/([^a-zA-Z0-9\/\x80-\xff]+)$//;
  1957. } else {
  1958. ($punct) = ($url =~ /([^a-zA-Z0-9\/\xc0-\xff]+)$/);
  1959. $url =~ s/([^a-zA-Z0-9\/\xc0-\xff]+)$//;
  1960. }
  1961. return ($url, $punct);
  1962. }
  1963. sub StripUrlPunct {
  1964. my ($url) = @_;
  1965. my ($junk);
  1966. ($url, $junk) = &SplitUrlPunct($url);
  1967. return $url;
  1968. }
  1969. sub WikiHeadingNumber {
  1970. my ($depth, $text) = @_;
  1971. my ($anchor, $number);
  1972. return '' unless --$depth > 0; # Don't number H1s because it looks stupid
  1973. while (scalar @HeadingNumbers < ($depth-1)) {
  1974. push @HeadingNumbers, 1;
  1975. $TableOfContents .= '<dl><dt> </dt><dd>';
  1976. }
  1977. if (scalar @HeadingNumbers < $depth) {
  1978. push @HeadingNumbers, 0;
  1979. $TableOfContents .= '<dl><dt> </dt><dd>';
  1980. }
  1981. while (scalar @HeadingNumbers > $depth) {
  1982. pop @HeadingNumbers;
  1983. $TableOfContents .= "</dd></dl>\n\n";
  1984. }
  1985. $HeadingNumbers[$#HeadingNumbers]++;
  1986. $number = (join '.', @HeadingNumbers) . '. ';
  1987. # Remove embedded links. THIS IS FRAGILE!
  1988. $text = &RestoreSavedText($text);
  1989. $text =~ s/\<a\s[^\>]*?\>\?\<\/a\>//si; # No such page syntax
  1990. $text =~ s/\<a\s[^\>]*?\>(.*?)\<\/a\>/$1/si;
  1991. # Cook anchor by canonicalizing $text.
  1992. $anchor = $text;
  1993. $anchor =~ s/\<.*?\>//g;
  1994. $anchor =~ s/\W/_/g;
  1995. $anchor =~ s/__+/_/g;
  1996. $anchor =~ s/^_//;
  1997. $anchor =~ s/_$//;
  1998. # Last ditch effort
  1999. $anchor = '_' . (join '_', @HeadingNumbers) unless $anchor;
  2000. $TableOfContents .= $number . &ScriptLink("$OpenPageName#$anchor",$text)
  2001. . "</dd>\n<dt> </dt><dd>";
  2002. return &StoreHref(" name=\"$anchor\"") . $number;
  2003. }
  2004. sub WikiHeading {
  2005. my ($pre, $depth, $text) = @_;
  2006. $depth = length($depth);
  2007. $depth = 6 if ($depth > 6);
  2008. $text =~ s/^\s*#\s+/&WikiHeadingNumber($depth,$')/e; # $' == $POSTMATCH
  2009. return $pre . "<H$depth>$text</H$depth>\n";
  2010. }
  2011. # ==== Difference markup and HTML ====
  2012. sub GetDiffHTML {
  2013. my ($diffType, $id, $revOld, $revNew, $newText) = @_;
  2014. my ($html, $diffText, $diffTextTwo, $priorName, $links, $usecomma);
  2015. my ($major, $minor, $author, $useMajor, $useMinor, $useAuthor, $cacheName);
  2016. $links = "(";
  2017. $usecomma = 0;
  2018. $major = &ScriptLinkDiff(1, $id, T('major diff'), "");
  2019. $minor = &ScriptLinkDiff(2, $id, T('minor diff'), "");
  2020. $author = &ScriptLinkDiff(3, $id, T('author diff'), "");
  2021. $useMajor = 1;
  2022. $useMinor = 1;
  2023. $useAuthor = 1;
  2024. $diffType = &GetParam("defaultdiff", 1) if ($diffType == 4);
  2025. if ($diffType == 1) {
  2026. $priorName = T('major');
  2027. $cacheName = 'major';
  2028. $useMajor = 0;
  2029. } elsif ($diffType == 2) {
  2030. $priorName = T('minor');
  2031. $cacheName = 'minor';
  2032. $useMinor = 0;
  2033. } elsif ($diffType == 3) {
  2034. $priorName = T('author');
  2035. $cacheName = 'author';
  2036. $useAuthor = 0;
  2037. }
  2038. if ($revOld ne "") {
  2039. # Note: OpenKeptRevisions must have been done by caller.
  2040. # Eventually optimize if same as cached revision
  2041. $diffText = &GetKeptDiff($newText, $revOld, 1); # 1 = get lock
  2042. if ($diffText eq "") {
  2043. $diffText = T('(The revisions are identical or unavailable.)');
  2044. }
  2045. } else {
  2046. $diffText = &GetCacheDiff($cacheName);
  2047. }
  2048. $useMajor = 0 if ($useMajor && ($diffText eq &GetCacheDiff("major")));
  2049. $useMinor = 0 if ($useMinor && ($diffText eq &GetCacheDiff("minor")));
  2050. $useAuthor = 0 if ($useAuthor && ($diffText eq &GetCacheDiff("author")));
  2051. $useMajor = 0 if ((!defined(&GetPageCache('oldmajor'))) ||
  2052. (&GetPageCache("oldmajor") < 1));
  2053. $useAuthor = 0 if ((!defined(&GetPageCache('oldauthor'))) ||
  2054. (&GetPageCache("oldauthor") < 1));
  2055. if ($useMajor) {
  2056. $links .= $major;
  2057. $usecomma = 1;
  2058. }
  2059. if ($useMinor) {
  2060. $links .= ", " if ($usecomma);
  2061. $links .= $minor;
  2062. $usecomma = 1;
  2063. }
  2064. if ($useAuthor) {
  2065. $links .= ", " if ($usecomma);
  2066. $links .= $author;
  2067. }
  2068. if (!($useMajor || $useMinor || $useAuthor)) {
  2069. $links .= T('no other diffs');
  2070. }
  2071. $links .= ")";
  2072. if ((!defined($diffText)) || ($diffText eq "")) {
  2073. $diffText = T('No diff available.');
  2074. }
  2075. if ($revOld ne "") {
  2076. my $currentRevision = T('current revision');
  2077. $currentRevision = Ts('revision %s', $revNew) if $revNew;
  2078. $html = '<b>'
  2079. . Tss("Difference (from revision %1 to %2)", $revOld, $currentRevision)
  2080. . "</b>\n" . "$links<br>" . &DiffToHTML($diffText);
  2081. } else {
  2082. if (($diffType != 2) &&
  2083. ((!defined(&GetPageCache("old$cacheName"))) ||
  2084. (&GetPageCache("old$cacheName") < 1))) {
  2085. $html = '<b>'
  2086. . Ts('No diff available--this is the first %s revision.',
  2087. $priorName) . "</b>\n$links";
  2088. } else {
  2089. $html = '<b>'
  2090. . Ts('Difference (from prior %s revision)', $priorName)
  2091. . "</b>\n$links<br>" . &DiffToHTML($diffText);
  2092. }
  2093. }
  2094. @HeadingNumbers = ();
  2095. $TableOfContents = '';
  2096. return $html;
  2097. }
  2098. sub GetCacheDiff {
  2099. my ($type) = @_;
  2100. my ($diffText);
  2101. $diffText = &GetPageCache("diff_default_$type");
  2102. $diffText = &GetCacheDiff('minor') if ($diffText eq "1");
  2103. $diffText = &GetCacheDiff('major') if ($diffText eq "2");
  2104. return $diffText;
  2105. }
  2106. # Must be done after minor diff is set and OpenKeptRevisions called
  2107. sub GetKeptDiff {
  2108. my ($newText, $oldRevision, $lock) = @_;
  2109. my (%sect, %data, $oldText);
  2110. $oldText = "";
  2111. if (defined($KeptRevisions{$oldRevision})) {
  2112. %sect = split(/$FS2/, $KeptRevisions{$oldRevision}, -1);
  2113. %data = split(/$FS3/, $sect{'data'}, -1);
  2114. $oldText = $data{'text'};
  2115. }
  2116. return "" if ($oldText eq ""); # Old revision not found
  2117. return &GetDiff($oldText, $newText, $lock);
  2118. }
  2119. sub GetDiff {
  2120. my ($old, $new, $lock) = @_;
  2121. my ($diff_out, $oldName, $newName);
  2122. &CreateDir($TempDir);
  2123. $oldName = "$TempDir/old_diff";
  2124. $newName = "$TempDir/new_diff";
  2125. if ($lock) {
  2126. &RequestDiffLock() or return "";
  2127. $oldName .= "_locked";
  2128. $newName .= "_locked";
  2129. }
  2130. &WriteStringToFile($oldName, $old);
  2131. &WriteStringToFile($newName, $new);
  2132. $diff_out = `diff $oldName $newName`;
  2133. &ReleaseDiffLock() if ($lock);
  2134. $diff_out =~ s/\\ No newline.*\n//g; # Get rid of common complaint.
  2135. # No need to unlink temp files--next diff will just overwrite.
  2136. return $diff_out;
  2137. }
  2138. sub DiffToHTML {
  2139. my ($html) = @_;
  2140. my ($tChanged, $tRemoved, $tAdded);
  2141. $tChanged = T('Changed:');
  2142. $tRemoved = T('Removed:');
  2143. $tAdded = T('Added:');
  2144. $html =~ s/\n--+//g;
  2145. # Note: Need spaces before <br> to be different from diff section.
  2146. $html =~ s/(^|\n)(\d+.*c.*)/$1 <br><strong>$tChanged $2<\/strong><br>/g;
  2147. $html =~ s/(^|\n)(\d+.*d.*)/$1 <br><strong>$tRemoved $2<\/strong><br>/g;
  2148. $html =~ s/(^|\n)(\d+.*a.*)/$1 <br><strong>$tAdded $2<\/strong><br>/g;
  2149. $html =~ s/\n((<.*\n)+)/&ColorDiff($1, $DiffColor1, 0)/ge;
  2150. $html =~ s/\n((>.*\n)+)/&ColorDiff($1, $DiffColor2, 1)/ge;
  2151. return $html;
  2152. }
  2153. sub ColorDiff {
  2154. my ($diff, $color, $type) = @_;
  2155. my ($colorHtml, $classHtml);
  2156. $diff =~ s/(^|\n)[<>]/$1/g;
  2157. $diff = &QuoteHtml($diff);
  2158. # Do some of the Wiki markup rules:
  2159. %SaveUrl = ();
  2160. %SaveNumUrl = ();
  2161. $SaveUrlIndex = 0;
  2162. $SaveNumUrlIndex = 0;
  2163. $diff = &RemoveFS($diff);
  2164. $diff = &CommonMarkup($diff, 0, 1); # No images, all patterns
  2165. if ($LateRules ne '') {
  2166. $diff = &EvalLocalRules($LateRules, $diff, 1);
  2167. }
  2168. 1 while $diff =~ s/$FS(\d+)$FS/$SaveUrl{$1}/ge; # Restore saved text
  2169. $diff =~ s/\r?\n/<br>/g;
  2170. $colorHtml = '';
  2171. if ($color ne '') {
  2172. $colorHtml = " bgcolor=$color";
  2173. }
  2174. if ($type) {
  2175. $classHtml = ' class=wikidiffnew';
  2176. } else {
  2177. $classHtml = ' class=wikidiffold';
  2178. }
  2179. return "<table width=\"95\%\"$colorHtml$classHtml><tr><td>\n" . $diff
  2180. . "</td></tr></table>\n";
  2181. }
  2182. # ==== Database (Page, Section, Text, Kept, User) functions ====
  2183. sub OpenNewPage {
  2184. my ($id) = @_;
  2185. %Page = ();
  2186. $Page{'version'} = 3; # Data format version
  2187. $Page{'revision'} = 0; # Number of edited times
  2188. $Page{'tscreate'} = $Now; # Set once at creation
  2189. $Page{'ts'} = $Now; # Updated every edit
  2190. }
  2191. sub OpenNewSection {
  2192. my ($name, $data) = @_;
  2193. %Section = ();
  2194. $Section{'name'} = $name;
  2195. $Section{'version'} = 1; # Data format version
  2196. $Section{'revision'} = 0; # Number of edited times
  2197. $Section{'tscreate'} = $Now; # Set once at creation
  2198. $Section{'ts'} = $Now; # Updated every edit
  2199. $Section{'ip'} = $ENV{REMOTE_ADDR};
  2200. $Section{'host'} = ''; # Updated only for real edits (can be slow)
  2201. $Section{'id'} = $UserID;
  2202. $Section{'username'} = &GetParam("username", "");
  2203. $Section{'data'} = $data;
  2204. $Page{$name} = join($FS2, %Section); # Replace with save?
  2205. }
  2206. sub OpenNewText {
  2207. my ($name) = @_; # Name of text (usually "default")
  2208. %Text = ();
  2209. if ($NewText ne '') {
  2210. $Text{'text'} = T($NewText);
  2211. } else {
  2212. $Text{'text'} = T('Describe the new page here.') . "\n";
  2213. }
  2214. $Text{'text'} .= "\n" if (substr($Text{'text'}, -1, 1) ne "\n");
  2215. $Text{'minor'} = 0; # Default as major edit
  2216. $Text{'newauthor'} = 1; # Default as new author
  2217. $Text{'summary'} = '';
  2218. &OpenNewSection("text_$name", join($FS3, %Text));
  2219. }
  2220. sub GetPageFile {
  2221. my ($id) = @_;
  2222. return $PageDir . "/" . &GetPageDirectory($id) . "/$id.db";
  2223. }
  2224. sub OpenPage {
  2225. my ($id) = @_;
  2226. my ($fname, $data);
  2227. if ($OpenPageName eq $id) {
  2228. return;
  2229. }
  2230. %Section = ();
  2231. %Text = ();
  2232. $fname = &GetPageFile($id);
  2233. if (-f $fname) {
  2234. $data = &ReadFileOrDie($fname);
  2235. %Page = split(/$FS1/, $data, -1); # -1 keeps trailing null fields
  2236. } else {
  2237. &OpenNewPage($id);
  2238. }
  2239. if ($Page{'version'} != 3) {
  2240. &UpdatePageVersion();
  2241. }
  2242. $OpenPageName = $id;
  2243. }
  2244. sub OpenSection {
  2245. my ($name) = @_;
  2246. if (!defined($Page{$name})) {
  2247. &OpenNewSection($name, "");
  2248. } else {
  2249. %Section = split(/$FS2/, $Page{$name}, -1);
  2250. }
  2251. }
  2252. sub OpenText {
  2253. my ($name) = @_;
  2254. if (!defined($Page{"text_$name"})) {
  2255. &OpenNewText($name);
  2256. } else {
  2257. &OpenSection("text_$name");
  2258. %Text = split(/$FS3/, $Section{'data'}, -1);
  2259. }
  2260. }
  2261. sub OpenDefaultText {
  2262. &OpenText('default');
  2263. }
  2264. # Called after OpenKeptRevisions
  2265. sub OpenKeptRevision {
  2266. my ($revision) = @_;
  2267. %Section = split(/$FS2/, $KeptRevisions{$revision}, -1);
  2268. %Text = split(/$FS3/, $Section{'data'}, -1);
  2269. }
  2270. sub GetPageCache {
  2271. my ($name) = @_;
  2272. return $Page{"cache_$name"};
  2273. }
  2274. # Always call SavePage within a lock.
  2275. sub SavePage {
  2276. my $file = &GetPageFile($OpenPageName);
  2277. $Page{'revision'} += 1; # Number of edited times
  2278. $Page{'ts'} = $Now; # Updated every edit
  2279. &CreatePageDir($PageDir, $OpenPageName);
  2280. &WriteStringToFile($file, join($FS1, %Page));
  2281. }
  2282. sub SaveSection {
  2283. my ($name, $data) = @_;
  2284. $Section{'revision'} += 1; # Number of edited times
  2285. $Section{'ts'} = $Now; # Updated every edit
  2286. $Section{'ip'} = $ENV{REMOTE_ADDR};
  2287. $Section{'id'} = $UserID;
  2288. $Section{'username'} = &GetParam("username", "");
  2289. $Section{'data'} = $data;
  2290. $Page{$name} = join($FS2, %Section);
  2291. }
  2292. sub SaveText {
  2293. my ($name) = @_;
  2294. &SaveSection("text_$name", join($FS3, %Text));
  2295. }
  2296. sub SaveDefaultText {
  2297. &SaveText('default');
  2298. }
  2299. sub SetPageCache {
  2300. my ($name, $data) = @_;
  2301. $Page{"cache_$name"} = $data;
  2302. }
  2303. sub UpdatePageVersion {
  2304. &ReportError(T('Bad page version (or corrupt page).'));
  2305. }
  2306. sub KeepFileName {
  2307. return $KeepDir . "/" . &GetPageDirectory($OpenPageName)
  2308. . "/$OpenPageName.kp";
  2309. }
  2310. sub SaveKeepSection {
  2311. my $file = &KeepFileName();
  2312. my $data;
  2313. return if ($Section{'revision'} < 1); # Don't keep "empty" revision
  2314. $Section{'keepts'} = $Now;
  2315. $data = $FS1 . join($FS2, %Section);
  2316. &CreatePageDir($KeepDir, $OpenPageName);
  2317. &AppendStringToFileLimited($file, $data, $KeepSize);
  2318. }
  2319. sub ExpireKeepFile {
  2320. my ($fname, $data, @kplist, %tempSection, $expirets);
  2321. my ($anyExpire, $anyKeep, $expire, %keepFlag, $sectName, $sectRev);
  2322. my ($oldMajor, $oldAuthor);
  2323. $fname = &KeepFileName();
  2324. return if (!(-f $fname));
  2325. $data = &ReadFileOrDie($fname);
  2326. @kplist = split(/$FS1/, $data, -1); # -1 keeps trailing null fields
  2327. return if (length(@kplist) < 1); # Also empty
  2328. shift(@kplist) if ($kplist[0] eq ""); # First can be empty
  2329. return if (length(@kplist) < 1); # Also empty
  2330. %tempSection = split(/$FS2/, $kplist[0], -1);
  2331. if (!defined($tempSection{'keepts'})) {
  2332. return; # Bad keep file
  2333. }
  2334. $expirets = $Now - ($KeepDays * 24 * 60 * 60);
  2335. return if ($tempSection{'keepts'} >= $expirets); # Nothing old enough
  2336. $anyExpire = 0;
  2337. $anyKeep = 0;
  2338. %keepFlag = ();
  2339. $oldMajor = &GetPageCache('oldmajor');
  2340. $oldAuthor = &GetPageCache('oldauthor');
  2341. foreach (reverse @kplist) {
  2342. %tempSection = split(/$FS2/, $_, -1);
  2343. $sectName = $tempSection{'name'};
  2344. $sectRev = $tempSection{'revision'};
  2345. $expire = 0;
  2346. if ($sectName eq "text_default") {
  2347. if (($KeepMajor && ($sectRev == $oldMajor)) ||
  2348. ($KeepAuthor && ($sectRev == $oldAuthor))) {
  2349. $expire = 0;
  2350. } elsif ($tempSection{'keepts'} < $expirets) {
  2351. $expire = 1;
  2352. }
  2353. } else {
  2354. if ($tempSection{'keepts'} < $expirets) {
  2355. $expire = 1;
  2356. }
  2357. }
  2358. if (!$expire) {
  2359. $keepFlag{$sectRev . "," . $sectName} = 1;
  2360. $anyKeep = 1;
  2361. } else {
  2362. $anyExpire = 1;
  2363. }
  2364. }
  2365. if (!$anyKeep) { # Empty, so remove file
  2366. unlink($fname);
  2367. return;
  2368. }
  2369. return if (!$anyExpire); # No sections expired
  2370. open (OUT, ">$fname") or die (Ts('cant write %s', $fname) . ": $!");
  2371. foreach (@kplist) {
  2372. %tempSection = split(/$FS2/, $_, -1);
  2373. $sectName = $tempSection{'name'};
  2374. $sectRev = $tempSection{'revision'};
  2375. if ($keepFlag{$sectRev . "," . $sectName}) {
  2376. print OUT $FS1, $_;
  2377. }
  2378. }
  2379. close(OUT);
  2380. }
  2381. sub OpenKeptList {
  2382. my ($fname, $data);
  2383. @KeptList = ();
  2384. $fname = &KeepFileName();
  2385. return if (!(-f $fname));
  2386. $data = &ReadFileOrDie($fname);
  2387. @KeptList = split(/$FS1/, $data, -1); # -1 keeps trailing null fields
  2388. }
  2389. sub OpenKeptRevisions {
  2390. my ($name) = @_; # Name of section
  2391. my ($fname, $data, %tempSection);
  2392. %KeptRevisions = ();
  2393. &OpenKeptList();
  2394. foreach (@KeptList) {
  2395. %tempSection = split(/$FS2/, $_, -1);
  2396. next if ($tempSection{'name'} ne $name);
  2397. $KeptRevisions{$tempSection{'revision'}} = $_;
  2398. }
  2399. }
  2400. sub LoadUserData {
  2401. my ($data, $status);
  2402. %UserData = ();
  2403. ($status, $data) = &ReadFile(&UserDataFilename($UserID));
  2404. if (!$status) {
  2405. $UserID = 112; # Could not open file. Consider warning message?
  2406. return;
  2407. }
  2408. %UserData = split(/$FS1/, $data, -1); # -1 keeps trailing null fields
  2409. }
  2410. sub UserDataFilename {
  2411. my ($id) = @_;
  2412. return "" if ($id < 1);
  2413. return $UserDir . "/" . ($id % 10) . "/$id.db";
  2414. }
  2415. # ==== Misc. functions ====
  2416. sub ReportError {
  2417. my ($errmsg) = @_;
  2418. print $q->header, $q->start_html, "<H2>", &QuoteHtml($errmsg), "</H2>", $q->end_html;
  2419. }
  2420. sub ValidId {
  2421. my ($id) = @_;
  2422. if (length($id) > 120) {
  2423. return Ts('Page name is too long: %s', $id);
  2424. }
  2425. if ($id =~ m| |) {
  2426. return Ts('Page name may not contain space characters: %s', $id);
  2427. }
  2428. if ($UseSubpage) {
  2429. if ($id =~ m|.*/.*/|) {
  2430. return Ts('Too many / characters in page %s', $id);
  2431. }
  2432. if ($id =~ /^\//) {
  2433. return Ts('Invalid Page %s (subpage without main page)', $id);
  2434. }
  2435. if ($id =~ /\/$/) {
  2436. return Ts('Invalid Page %s (missing subpage name)', $id);
  2437. }
  2438. }
  2439. if ($FreeLinks) {
  2440. $id =~ s/ /_/g;
  2441. if (!$UseSubpage) {
  2442. if ($id =~ /\//) {
  2443. return Ts('Invalid Page %s (/ not allowed)', $id);
  2444. }
  2445. }
  2446. if (!($id =~ m|^$FreeLinkPattern$|)) {
  2447. return Ts('Invalid Page %s', $id);
  2448. }
  2449. if ($id =~ m|\.db$|) {
  2450. return Ts('Invalid Page %s (must not end with .db)', $id);
  2451. }
  2452. if ($id =~ m|\.lck$|) {
  2453. return Ts('Invalid Page %s (must not end with .lck)', $id);
  2454. }
  2455. return "";
  2456. } else {
  2457. if (!($id =~ /^$LinkPattern$/)) {
  2458. return Ts('Invalid Page %s', $id);
  2459. }
  2460. }
  2461. return "";
  2462. }
  2463. sub ValidIdOrDie {
  2464. my ($id) = @_;
  2465. my $error;
  2466. $error = &ValidId($id);
  2467. if ($error ne "") {
  2468. &ReportError($error);
  2469. return 0;
  2470. }
  2471. return 1;
  2472. }
  2473. sub UserCanEdit {
  2474. my ($id, $deepCheck) = @_;
  2475. # Optimized for the "everyone can edit" case (don't check passwords)
  2476. if (($id ne "") && (-f &GetLockedPageFile($id))) {
  2477. return 1 if (&UserIsAdmin()); # Requires more privledges
  2478. # Consider option for editor-level to edit these pages?
  2479. return 0;
  2480. }
  2481. if (!$EditAllowed) {
  2482. return 1 if (&UserIsEditor());
  2483. return 0;
  2484. }
  2485. if (-f "$DataDir/noedit") {
  2486. return 1 if (&UserIsEditor());
  2487. return 0;
  2488. }
  2489. if ($deepCheck) { # Deeper but slower checks (not every page)
  2490. return 1 if (&UserIsEditor());
  2491. return 0 if (&UserIsBanned());
  2492. }
  2493. return 1;
  2494. }
  2495. sub UserIsBanned {
  2496. my ($host, $ip, $data, $status);
  2497. ($status, $data) = &ReadFile("$DataDir/banlist");
  2498. return 0 if (!$status); # No file exists, so no ban
  2499. $data =~ s/\r//g;
  2500. $ip = $ENV{'REMOTE_ADDR'};
  2501. $host = &GetRemoteHost(0);
  2502. foreach (split(/\n/, $data)) {
  2503. next if ((/^\s*$/) || (/^#/)); # Skip empty, spaces, or comments
  2504. return 1 if ($ip =~ /$_/i);
  2505. return 1 if ($host =~ /$_/i);
  2506. }
  2507. return 0;
  2508. }
  2509. sub UserIsAdmin {
  2510. my (@pwlist, $userPassword);
  2511. return 0 if ($AdminPass eq "");
  2512. $userPassword = &GetParam("adminpw", "");
  2513. return 0 if ($userPassword eq "");
  2514. foreach (split(/\s+/, $AdminPass)) {
  2515. next if ($_ eq "");
  2516. return 1 if ($userPassword eq $_);
  2517. }
  2518. return 0;
  2519. }
  2520. sub UserIsEditor {
  2521. my (@pwlist, $userPassword);
  2522. return 1 if (&UserIsAdmin()); # Admin includes editor
  2523. return 0 if ($EditPass eq "");
  2524. $userPassword = &GetParam("adminpw", ""); # Used for both
  2525. return 0 if ($userPassword eq "");
  2526. foreach (split(/\s+/, $EditPass)) {
  2527. next if ($_ eq "");
  2528. return 1 if ($userPassword eq $_);
  2529. }
  2530. return 0;
  2531. }
  2532. sub UserCanUpload {
  2533. return 1 if (&UserIsEditor());
  2534. return $AllUpload;
  2535. }
  2536. sub GetLockedPageFile {
  2537. my ($id) = @_;
  2538. return $PageDir . "/" . &GetPageDirectory($id) . "/$id.lck";
  2539. }
  2540. sub RequestLockDir {
  2541. my ($name, $tries, $wait, $errorDie) = @_;
  2542. my ($lockName, $n);
  2543. &CreateDir($TempDir);
  2544. $lockName = $LockDir . $name;
  2545. $n = 0;
  2546. while (mkdir($lockName, 0555) == 0) {
  2547. if ($! != 17) {
  2548. die(Ts('can not make %s', $LockDir) . ": $!\n") if $errorDie;
  2549. return 0;
  2550. }
  2551. return 0 if ($n++ >= $tries);
  2552. sleep($wait);
  2553. }
  2554. return 1;
  2555. }
  2556. sub ReleaseLockDir {
  2557. my ($name) = @_;
  2558. rmdir($LockDir . $name);
  2559. }
  2560. sub RequestLock {
  2561. # 10 tries, 3 second wait, possibly die on error
  2562. return &RequestLockDir("main", 10, 3, $LockCrash);
  2563. }
  2564. sub ReleaseLock {
  2565. &ReleaseLockDir('main');
  2566. }
  2567. sub ForceReleaseLock {
  2568. my ($name) = @_;
  2569. my $forced;
  2570. # First try to obtain lock (in case of normal edit lock)
  2571. # 5 tries, 3 second wait, do not die on error
  2572. $forced = !&RequestLockDir($name, 5, 3, 0);
  2573. &ReleaseLockDir($name); # Release the lock, even if we didn't get it.
  2574. return $forced;
  2575. }
  2576. sub RequestCacheLock {
  2577. # 4 tries, 2 second wait, do not die on error
  2578. return &RequestLockDir('cache', 4, 2, 0);
  2579. }
  2580. sub ReleaseCacheLock {
  2581. &ReleaseLockDir('cache');
  2582. }
  2583. sub RequestDiffLock {
  2584. # 4 tries, 2 second wait, do not die on error
  2585. return &RequestLockDir('diff', 4, 2, 0);
  2586. }
  2587. sub ReleaseDiffLock {
  2588. &ReleaseLockDir('diff');
  2589. }
  2590. # Index lock is not very important--just return error if not available
  2591. sub RequestIndexLock {
  2592. # 1 try, 2 second wait, do not die on error
  2593. return &RequestLockDir('index', 1, 2, 0);
  2594. }
  2595. sub ReleaseIndexLock {
  2596. &ReleaseLockDir('index');
  2597. }
  2598. sub ReadFile {
  2599. my ($fileName) = @_;
  2600. my ($data);
  2601. local $/ = undef; # Read complete files
  2602. if (open(IN, "<$fileName")) {
  2603. $data=<IN>;
  2604. close IN;
  2605. return (1, $data);
  2606. }
  2607. return (0, "");
  2608. }
  2609. sub ReadFileOrDie {
  2610. my ($fileName) = @_;
  2611. my ($status, $data);
  2612. ($status, $data) = &ReadFile($fileName);
  2613. if (!$status) {
  2614. die(Ts('Can not open %s', $fileName) . ": $!");
  2615. }
  2616. return $data;
  2617. }
  2618. sub WriteStringToFile {
  2619. my ($file, $string) = @_;
  2620. open (OUT, ">$file") or die(Ts('cant write %s', $file) . ": $!");
  2621. print OUT $string;
  2622. close(OUT);
  2623. }
  2624. sub AppendStringToFile {
  2625. my ($file, $string) = @_;
  2626. open (OUT, ">>$file") or die(Ts('cant write %s', $file) . ": $!");
  2627. print OUT $string;
  2628. close(OUT);
  2629. }
  2630. sub AppendStringToFileLimited {
  2631. my ($file, $string, $limit) = @_;
  2632. if (($limit < 1) || (((-s $file) + length($string)) <= $limit)) {
  2633. &AppendStringToFile($file, $string);
  2634. }
  2635. }
  2636. sub CreateDir {
  2637. my ($newdir) = @_;
  2638. mkdir($newdir, 0775) if (!(-d $newdir));
  2639. }
  2640. sub CreatePageDir {
  2641. my ($dir, $id) = @_;
  2642. my $subdir;
  2643. &CreateDir($dir); # Make sure main page exists
  2644. $subdir = $dir . "/" . &GetPageDirectory($id);
  2645. &CreateDir($subdir);
  2646. if ($id =~ m|([^/]+)/|) {
  2647. $subdir = $subdir . "/" . $1;
  2648. &CreateDir($subdir);
  2649. }
  2650. }
  2651. sub UpdateHtmlCache {
  2652. my ($id, $html) = @_;
  2653. my $idFile;
  2654. $idFile = &GetHtmlCacheFile($id);
  2655. &CreatePageDir($HtmlDir, $id);
  2656. if (&RequestCacheLock()) {
  2657. &WriteStringToFile($idFile, $html);
  2658. &ReleaseCacheLock();
  2659. }
  2660. }
  2661. sub GenerateAllPagesList {
  2662. my (@pages, @dirs, $id, $dir, @pageFiles, @subpageFiles, $subId);
  2663. @pages = ();
  2664. if ($FastGlob) {
  2665. # The following was inspired by the FastGlob code by Marc W. Mengel.
  2666. # Thanks to Bob Showalter for pointing out the improvement.
  2667. opendir(PAGELIST, $PageDir);
  2668. @dirs = readdir(PAGELIST);
  2669. closedir(PAGELIST);
  2670. @dirs = sort(@dirs);
  2671. foreach $dir (@dirs) {
  2672. next if (substr($dir, 0, 1) eq '.'); # No ., .., or .dirs or files
  2673. opendir(PAGELIST, "$PageDir/$dir");
  2674. @pageFiles = readdir(PAGELIST);
  2675. closedir(PAGELIST);
  2676. foreach $id (@pageFiles) {
  2677. next if (($id eq '.') || ($id eq '..'));
  2678. if (substr($id, -3) eq '.db') {
  2679. push(@pages, substr($id, 0, -3));
  2680. } elsif (substr($id, -4) ne '.lck') {
  2681. opendir(PAGELIST, "$PageDir/$dir/$id");
  2682. @subpageFiles = readdir(PAGELIST);
  2683. closedir(PAGELIST);
  2684. foreach $subId (@subpageFiles) {
  2685. if (substr($subId, -3) eq '.db') {
  2686. push(@pages, "$id/" . substr($subId, 0, -3));
  2687. }
  2688. }
  2689. }
  2690. }
  2691. }
  2692. } else {
  2693. # Old slow/compatible method.
  2694. @dirs = qw(A B C D E F G H I J K L M N O P Q R S T U V W X Y Z other);
  2695. foreach $dir (@dirs) {
  2696. if (-e "$PageDir/$dir") { # Thanks to Tim Holt
  2697. while (<$PageDir/$dir/*.db $PageDir/$dir/*/*.db>) {
  2698. s|^$PageDir/||;
  2699. m|^[^/]+/(\S*).db|;
  2700. $id = $1;
  2701. push(@pages, $id);
  2702. }
  2703. }
  2704. }
  2705. }
  2706. return sort(@pages);
  2707. }
  2708. sub AllPagesList {
  2709. my ($rawIndex, $refresh, $status);
  2710. if (!$UseIndex) {
  2711. return &GenerateAllPagesList();
  2712. }
  2713. $refresh = &GetParam("refresh", 0);
  2714. if ($IndexInit && !$refresh) {
  2715. # Note for mod_perl: $IndexInit is reset for each query
  2716. # Eventually consider some timestamp-solution to keep cache?
  2717. return @IndexList;
  2718. }
  2719. if ((!$refresh) && (-f $IndexFile)) {
  2720. ($status, $rawIndex) = &ReadFile($IndexFile);
  2721. if ($status) {
  2722. %IndexHash = split(/\s+/, $rawIndex);
  2723. @IndexList = sort(keys %IndexHash);
  2724. $IndexInit = 1;
  2725. return @IndexList;
  2726. }
  2727. # If open fails just refresh the index
  2728. }
  2729. @IndexList = ();
  2730. %IndexHash = ();
  2731. @IndexList = &GenerateAllPagesList();
  2732. foreach (@IndexList) {
  2733. $IndexHash{$_} = 1;
  2734. }
  2735. $IndexInit = 1; # Initialized for this run of the script
  2736. # Try to write out the list for future runs
  2737. &RequestIndexLock() or return @IndexList;
  2738. &WriteStringToFile($IndexFile, join(" ", %IndexHash));
  2739. &ReleaseIndexLock();
  2740. return @IndexList;
  2741. }
  2742. sub CalcDay {
  2743. my ($ts) = @_;
  2744. $ts += $TimeZoneOffset;
  2745. my ($sec, $min, $hour, $mday, $mon, $year) = localtime($ts);
  2746. if ($NumberDates) {
  2747. return ($year + 1900) . '-' . ($mon+1) . '-' . $mday;
  2748. }
  2749. return ("January", "February", "March", "April", "May", "June",
  2750. "July", "August", "September", "October", "November",
  2751. "December")[$mon]. " " . $mday . ", " . ($year+1900);
  2752. }
  2753. sub CalcTime {
  2754. my ($ts) = @_;
  2755. my ($ampm, $mytz);
  2756. $ts += $TimeZoneOffset;
  2757. my ($sec, $min, $hour, $mday, $mon, $year) = localtime($ts);
  2758. $mytz = "";
  2759. if (($TimeZoneOffset == 0) && ($ScriptTZ ne "")) {
  2760. $mytz = " " . $ScriptTZ;
  2761. }
  2762. $ampm = "";
  2763. if ($UseAmPm) {
  2764. $ampm = " am";
  2765. if ($hour > 11) {
  2766. $ampm = " pm";
  2767. $hour = $hour - 12;
  2768. }
  2769. $hour = 12 if ($hour == 0);
  2770. }
  2771. $min = "0" . $min if ($min<10);
  2772. return $hour . ":" . $min . $ampm . $mytz;
  2773. }
  2774. sub TimeToText {
  2775. my ($t) = @_;
  2776. return &CalcDay($t) . " " . &CalcTime($t);
  2777. }
  2778. sub GetParam {
  2779. my ($name, $default) = @_;
  2780. my $result;
  2781. $result = $q->param($name);
  2782. if (!defined($result)) {
  2783. if (defined($UserData{$name})) {
  2784. $result = $UserData{$name};
  2785. } else {
  2786. $result = $default;
  2787. }
  2788. }
  2789. return $result;
  2790. }
  2791. sub GetHiddenValue {
  2792. my ($name, $value) = @_;
  2793. $q->param($name, $value);
  2794. return $q->hidden($name);
  2795. }
  2796. sub GetRemoteHost {
  2797. my ($doMask) = @_;
  2798. my ($rhost, $iaddr);
  2799. $rhost = $ENV{REMOTE_HOST};
  2800. if ($UseLookup && ($rhost eq "")) {
  2801. # Catch errors (including bad input) without aborting the script
  2802. eval 'use Socket; $iaddr = inet_aton($ENV{REMOTE_ADDR});'
  2803. . '$rhost = gethostbyaddr($iaddr, AF_INET)';
  2804. }
  2805. if ($rhost eq "") {
  2806. $rhost = $ENV{REMOTE_ADDR};
  2807. }
  2808. $rhost = &GetMaskedHost($rhost) if ($doMask);
  2809. return $rhost;
  2810. }
  2811. sub FreeToNormal {
  2812. my ($id) = @_;
  2813. $id =~ s/ /_/g;
  2814. $id = ucfirst($id) if ($UpperFirst || $FreeUpper);
  2815. if (index($id, '_') > -1) { # Quick check for any space/underscores
  2816. $id =~ s/__+/_/g;
  2817. $id =~ s/^_//;
  2818. $id =~ s/_$//;
  2819. if ($UseSubpage) {
  2820. $id =~ s|_/|/|g;
  2821. $id =~ s|/_|/|g;
  2822. }
  2823. }
  2824. if ($FreeUpper) {
  2825. # Note that letters after ' are *not* capitalized
  2826. if ($id =~ m|[-_.,\(\)/][a-z]|) { # Quick check for non-canonical case
  2827. $id =~ s|([-_.,\(\)/])([a-z])|$1 . uc($2)|ge;
  2828. }
  2829. }
  2830. return $id;
  2831. }
  2832. #END_OF_BROWSE_CODE
  2833. # == Page-editing and other special-action code ========================
  2834. $OtherCode = ""; # Comment next line to always compile (slower)
  2835. #$OtherCode = <<'#END_OF_OTHER_CODE';
  2836. sub DoOtherRequest {
  2837. my ($id, $action, $text, $search);
  2838. $action = &GetParam("action", "");
  2839. $id = &GetParam("id", "");
  2840. if ($action ne "") {
  2841. $action = lc($action);
  2842. if ($action eq "edit") {
  2843. &DoEdit($id, 0, 0, "", 0) if &ValidIdOrDie($id);
  2844. } elsif ($action eq "unlock") {
  2845. &DoUnlock();
  2846. } elsif ($action eq "index") {
  2847. &DoIndex();
  2848. } elsif ($action eq "links") {
  2849. &DoLinks();
  2850. } elsif ($action eq "maintain") {
  2851. &DoMaintain();
  2852. } elsif ($action eq "pagelock") {
  2853. &DoPageLock();
  2854. } elsif ($action eq "editlock") {
  2855. &DoEditLock();
  2856. } elsif ($action eq "editprefs") {
  2857. &DoEditPrefs();
  2858. } elsif ($action eq "editbanned") {
  2859. &DoEditBanned();
  2860. } elsif ($action eq "editlinks") {
  2861. &DoEditLinks();
  2862. } elsif ($action eq "login") {
  2863. &DoEnterLogin();
  2864. } elsif ($action eq "newlogin") {
  2865. $UserID = 0;
  2866. &DoEditPrefs(); # Also creates new ID
  2867. } elsif ($action eq "version") {
  2868. &DoShowVersion();
  2869. } elsif ($action eq "rss") {
  2870. &DoRss();
  2871. } elsif ($action eq "delete") {
  2872. &DoDeletePage($id);
  2873. } elsif ($UseUpload && ($action eq "upload")) {
  2874. &DoUpload();
  2875. } elsif ($action eq "maintainrc") {
  2876. &DoMaintainRc();
  2877. } elsif ($action eq "convert") {
  2878. &DoConvert();
  2879. } elsif ($action eq "trimusers") {
  2880. &DoTrimUsers();
  2881. } else {
  2882. &ReportError(Ts('Invalid action parameter %s', $action));
  2883. }
  2884. return;
  2885. }
  2886. if (&GetParam("edit_prefs", 0)) {
  2887. &DoUpdatePrefs();
  2888. return;
  2889. }
  2890. if (&GetParam("edit_ban", 0)) {
  2891. &DoUpdateBanned();
  2892. return;
  2893. }
  2894. if (&GetParam("enter_login", 0)) {
  2895. &DoLogin();
  2896. return;
  2897. }
  2898. if (&GetParam("edit_links", 0)) {
  2899. &DoUpdateLinks();
  2900. return;
  2901. }
  2902. if ($UseUpload && (&GetParam("upload", 0))) {
  2903. &SaveUpload();
  2904. return;
  2905. }
  2906. $search = &GetParam("search", "");
  2907. if (($search ne "") || (&GetParam("dosearch", "") ne "")) {
  2908. &DoSearch($search);
  2909. return;
  2910. } else {
  2911. $search = &GetParam("back","");
  2912. if ($search ne "") {
  2913. &DoBackLinks($search);
  2914. return;
  2915. }
  2916. }
  2917. # Handle posted pages
  2918. if (&GetParam("oldtime", "") ne "") {
  2919. $id = &GetParam("title", "");
  2920. &DoPost() if &ValidIdOrDie($id);
  2921. return;
  2922. }
  2923. &ReportError(T('Invalid URL.'));
  2924. }
  2925. sub DoEdit {
  2926. my ($id, $isConflict, $oldTime, $newText, $preview) = @_;
  2927. my ($header, $editRows, $editCols, $userName, $revision, $oldText);
  2928. my ($summary, $isEdit, $pageTime);
  2929. if ($FreeLinks) {
  2930. $id = &FreeToNormal($id); # Take care of users like Markus Lude :-)
  2931. }
  2932. if (!&UserCanEdit($id, 1)) {
  2933. print &GetHeader('', T('Editing Denied'), '');
  2934. if (&UserIsBanned()) {
  2935. print T('Editing not allowed: user, ip, or network is blocked.');
  2936. print "<p>";
  2937. print T('Contact the wiki administrator for more information.');
  2938. } else {
  2939. print Ts('Editing not allowed: %s is read-only.', $SiteName);
  2940. }
  2941. print &GetCommonFooter();
  2942. return;
  2943. }
  2944. # Consider sending a new user-ID cookie if user does not have one
  2945. &OpenPage($id);
  2946. &OpenDefaultText();
  2947. $pageTime = $Section{'ts'};
  2948. $header = Ts('Editing %s', $id);
  2949. # Old revision handling
  2950. $revision = &GetParam('revision', '');
  2951. $revision =~ s/\D//g; # Remove non-numeric chars
  2952. if ($revision ne '') {
  2953. &OpenKeptRevisions('text_default');
  2954. if (!defined($KeptRevisions{$revision})) {
  2955. $revision = '';
  2956. # Consider better solution like error message?
  2957. } else {
  2958. &OpenKeptRevision($revision);
  2959. $header = Ts('Editing revision %s of ', $revision ) . $id;
  2960. }
  2961. }
  2962. $oldText = $Text{'text'};
  2963. if ($preview && !$isConflict) {
  2964. $oldText = $newText;
  2965. }
  2966. $editRows = &GetParam("editrows", 20);
  2967. $editCols = &GetParam("editcols", 65);
  2968. print &GetHeader($id, &QuoteHtml($header), '');
  2969. if ($revision ne '') {
  2970. print "\n<b>"
  2971. . Ts('Editing old revision %s.', $revision) . " "
  2972. . T('Saving this page will replace the latest revision with this text.')
  2973. . '</b><br>'
  2974. }
  2975. if ($isConflict) {
  2976. $editRows -= 10 if ($editRows > 19);
  2977. print "\n<H1>" . T('Edit Conflict!') . "</H1>\n";
  2978. if ($isConflict>1) {
  2979. # The main purpose of a new warning is to display more text
  2980. # and move the save button down from its old location.
  2981. print "\n<H2>" . T('(This is a new conflict)') . "</H2>\n";
  2982. }
  2983. print "<p><strong>",
  2984. T('Someone saved this page after you started editing.'), " ",
  2985. T('The top textbox contains the saved text.'), " ",
  2986. T('Only the text in the top textbox will be saved.'),
  2987. "</strong><br>\n",
  2988. T('Scroll down to see your edited text.'), "<br>\n";
  2989. print T('Last save time:'), ' ', &TimeToText($oldTime),
  2990. " (", T('Current time is:'), ' ', &TimeToText($Now), ")<br>\n";
  2991. }
  2992. print &GetFormStart();
  2993. print &GetHiddenValue("title", $id), "\n",
  2994. &GetHiddenValue("oldtime", $pageTime), "\n",
  2995. &GetHiddenValue("oldconflict", $isConflict), "\n";
  2996. if ($revision ne "") {
  2997. print &GetHiddenValue("revision", $revision), "\n";
  2998. }
  2999. print &GetTextArea('text', $oldText, $editRows, $editCols);
  3000. $summary = &GetParam("summary", "*");
  3001. print "<p>", T('Summary:'),
  3002. $q->textfield(-name=>'summary',
  3003. -default=>$summary, -override=>1,
  3004. -size=>60, -maxlength=>200);
  3005. if (&GetParam("recent_edit") eq "on") {
  3006. print "<br>", $q->checkbox(-name=>'recent_edit', -checked=>1,
  3007. -label=>T('This change is a minor edit.'));
  3008. } else {
  3009. print "<br>", $q->checkbox(-name=>'recent_edit',
  3010. -label=>T('This change is a minor edit.'));
  3011. }
  3012. if ($EmailNotify) {
  3013. print "&nbsp;&nbsp;&nbsp;" .
  3014. $q->checkbox(-name=> 'do_email_notify',
  3015. -label=>Ts('Send email notification that %s has been changed.', $id));
  3016. }
  3017. print "<br>";
  3018. if ($EditNote ne '') {
  3019. print T($EditNote) . '<br>'; # Allow translation
  3020. }
  3021. print $q->submit(-name=>'Save', -value=>T('Save')), "\n";
  3022. $userName = &GetParam("username", "");
  3023. if ($userName ne "") {
  3024. print ' (', T('Your user name is'), ' ',
  3025. &GetPageLink($userName) . ') ';
  3026. } else {
  3027. print ' (', Ts('Visit %s to set your user name.', &GetPrefsLink(), 1), ') ';
  3028. }
  3029. print $q->submit(-name=>'Preview', -value=>T('Preview')), "\n";
  3030. if ($isConflict) {
  3031. print "\n<br><hr><p><strong>", T('This is the text you submitted:'),
  3032. "</strong><p>",
  3033. &GetTextArea('newtext', $newText, $editRows, $editCols),
  3034. "<p>\n";
  3035. }
  3036. if ($preview) {
  3037. print '<div class=wikipreview>';
  3038. print "<hr class=wikilinepreview>\n";
  3039. print "<h2>", T('Preview:'), "</h2>\n";
  3040. if ($isConflict) {
  3041. print "<b>",
  3042. T('NOTE: This preview shows the revision of the other author.'),
  3043. "</b><hr>\n";
  3044. }
  3045. $MainPage = $id;
  3046. $MainPage =~ s|/.*||; # Only the main page name (remove subpage)
  3047. print &WikiToHTML($oldText) . "<hr class=wikilinepreview>\n";
  3048. print "<h2>", T('Preview only, not yet saved'), "</h2>\n";
  3049. print '</div>';
  3050. }
  3051. print $q->endform;
  3052. if (!&GetParam('embed', $EmbedWiki)) {
  3053. print '<div class=wikifooter>';
  3054. print "<hr class=wikilinefooter>\n";
  3055. print &GetHistoryLink($id, T('View other revisions')) . "<br>\n";
  3056. print &GetGotoBar($id);
  3057. print '</div>';
  3058. }
  3059. print &GetMinimumFooter();
  3060. }
  3061. sub GetTextArea {
  3062. my ($name, $text, $rows, $cols) = @_;
  3063. if (&GetParam("editwide", 1)) {
  3064. return $q->textarea(-name=>$name, -default=>$text,
  3065. -rows=>$rows, -columns=>$cols, -override=>1,
  3066. -style=>'width:100%', -wrap=>'virtual');
  3067. }
  3068. return $q->textarea(-name=>$name, -default=>$text,
  3069. -rows=>$rows, -columns=>$cols, -override=>1,
  3070. -wrap=>'virtual');
  3071. }
  3072. sub DoEditPrefs {
  3073. my ($check, $recentName, %labels);
  3074. $recentName = $RCName;
  3075. $recentName =~ s/_/ /g;
  3076. &DoNewLogin() if ($UserID < 400);
  3077. print &GetHeader('', T('Editing Preferences'), '');
  3078. print '<div class=wikipref>';
  3079. print &GetFormStart();
  3080. print GetHiddenValue("edit_prefs", 1), "\n";
  3081. print '<b>' . T('User Information:') . "</b>\n";
  3082. print '<br>' . Ts('Your User ID number: %s', $UserID) . "\n";
  3083. print '<br>' . T('UserName:') . ' ', &GetFormText('username', "", 20, 50);
  3084. print ' ' . T('(blank to remove, or valid page name)');
  3085. print '<br>' . T('Set Password:') . ' ',
  3086. $q->password_field(-name=>'p_password', -value=>'*',
  3087. -size=>15, -maxlength=>50),
  3088. ' ', T('(blank to remove password)'), '<br>(',
  3089. T('Passwords allow sharing preferences between multiple systems.'),
  3090. ' ', T('Passwords are completely optional.'), ')';
  3091. if (($AdminPass ne '') || ($EditPass ne '')) {
  3092. print '<br>', T('Administrator Password:'), ' ',
  3093. $q->password_field(-name=>'p_adminpw', -value=>'*',
  3094. -size=>15, -maxlength=>50),
  3095. ' ', T('(blank to remove password)'), '<br>',
  3096. T('(Administrator passwords are used for special maintenance.)');
  3097. }
  3098. if ($EmailNotify) {
  3099. print "<br>";
  3100. print &GetFormCheck('notify', 1,
  3101. T('Include this address in the site email list.')), ' ',
  3102. T('(Uncheck the box to remove the address.)');
  3103. print '<br>', T('Email Address:'), ' ',
  3104. &GetFormText('email', "", 30, 60);
  3105. }
  3106. print "<hr class=wikilinepref><b>$recentName:</b>\n";
  3107. print '<br>', T('Default days to display:'), ' ',
  3108. &GetFormText('rcdays', $RcDefault, 4, 9);
  3109. print "<br>", &GetFormCheck('rcnewtop', $RecentTop,
  3110. T('Most recent changes on top'));
  3111. print "<br>", &GetFormCheck('rcall', 0,
  3112. T('Show all changes (not just most recent)'));
  3113. %labels = (0=>T('Hide minor edits'), 1=>T('Show minor edits'),
  3114. 2=>T('Show only minor edits'));
  3115. print '<br>', T('Minor edit display:'), ' ';
  3116. print $q->popup_menu(-name=>'p_rcshowedit',
  3117. -values=>[0,1,2], -labels=>\%labels,
  3118. -default=>&GetParam("rcshowedit", $ShowEdits));
  3119. print "<br>", &GetFormCheck('rcchangehist', 1,
  3120. T('Use "changes" as link to history'));
  3121. if ($UseDiff) {
  3122. print '<hr class=wikilinepref><b>', T('Differences:'), "</b>\n";
  3123. print "<br>", &GetFormCheck('diffrclink', 1,
  3124. Ts('Show (diff) links on %s', $recentName));
  3125. print "<br>", &GetFormCheck('alldiff', 0,
  3126. T('Show differences on all pages'));
  3127. print " (", &GetFormCheck('norcdiff', 1,
  3128. Ts('No differences on %s', $recentName)), ")";
  3129. %labels = (1=>T('Major'), 2=>T('Minor'), 3=>T('Author'));
  3130. print '<br>', T('Default difference type:'), ' ';
  3131. print $q->popup_menu(-name=>'p_defaultdiff',
  3132. -values=>[1,2,3], -labels=>\%labels,
  3133. -default=>&GetParam("defaultdiff", 1));
  3134. }
  3135. print '<hr class=wikilinepref><b>', T('Misc:'), "</b>\n";
  3136. # Note: TZ offset is added by TimeToText, so pre-subtract to cancel.
  3137. print '<br>', T('Server time:'), ' ', &TimeToText($Now-$TimeZoneOffset);
  3138. print '<br>', T('Time Zone offset (hours):'), ' ',
  3139. &GetFormText('tzoffset', 0, 4, 9);
  3140. print '<br>', &GetFormCheck('editwide', 1,
  3141. T('Use 100% wide edit area (if supported)'));
  3142. print '<br>',
  3143. T('Edit area rows:'), ' ', &GetFormText('editrows', 20, 4, 4),
  3144. ' ', T('columns:'), ' ', &GetFormText('editcols', 65, 4, 4);
  3145. print '<br>', &GetFormCheck('toplinkbar', 1,
  3146. T('Show link bar on top'));
  3147. print '<br>', &GetFormCheck('linkrandom', 0,
  3148. T('Add "Random Page" link to link bar'));
  3149. print '<br>' . T('StyleSheet URL:') . ' ',
  3150. &GetFormText('stylesheet', "", 30, 150);
  3151. print '<br>', $q->submit(-name=>'Save', -value=>T('Save')), "\n";
  3152. print $q->endform;
  3153. print '</div>';
  3154. if (!&GetParam('embed', $EmbedWiki)) {
  3155. print '<div class=wikifooter>';
  3156. print "<hr class=wikilinefooter>\n";
  3157. print &GetGotoBar('');
  3158. print '</div>';
  3159. }
  3160. print &GetMinimumFooter();
  3161. }
  3162. sub GetFormText {
  3163. my ($name, $default, $size, $max) = @_;
  3164. my $text = &GetParam($name, $default);
  3165. return $q->textfield(-name=>"p_$name", -default=>$text,
  3166. -override=>1, -size=>$size, -maxlength=>$max);
  3167. }
  3168. sub GetFormCheck {
  3169. my ($name, $default, $label) = @_;
  3170. my $checked = (&GetParam($name, $default) > 0);
  3171. return $q->checkbox(-name=>"p_$name", -override=>1, -checked=>$checked,
  3172. -label=>$label);
  3173. }
  3174. sub DoUpdatePrefs {
  3175. my ($username, $password, $stylesheet);
  3176. # All link bar settings should be updated before printing the header
  3177. &UpdatePrefCheckbox("toplinkbar");
  3178. &UpdatePrefCheckbox("linkrandom");
  3179. print &GetHeader('', T('Saving Preferences'), '');
  3180. print '<br>';
  3181. if ($UserID < 1001) {
  3182. print '<b>',
  3183. Ts('Invalid UserID %s, preferences not saved.', $UserID), '</b>';
  3184. if ($UserID == 111) {
  3185. print '<br>',
  3186. T('(Preferences require cookies, but no cookie was sent.)');
  3187. }
  3188. print &GetCommonFooter();
  3189. return;
  3190. }
  3191. $username = &GetParam("p_username", "");
  3192. if ($FreeLinks) {
  3193. $username =~ s/^\[\[(.+)\]\]/$1/; # Remove [[ and ]] if added
  3194. $username = &FreeToNormal($username);
  3195. $username =~ s/_/ /g;
  3196. }
  3197. if ($username eq "") {
  3198. print T('UserName removed.'), '<br>';
  3199. undef $UserData{'username'};
  3200. } elsif ((!$FreeLinks) && (!($username =~ /^$LinkPattern$/))) {
  3201. print Ts('Invalid UserName %s: not saved.', $username), "<br>\n";
  3202. } elsif ($FreeLinks && (!($username =~ /^$FreeLinkPattern$/))) {
  3203. print Ts('Invalid UserName %s: not saved.', $username), "<br>\n";
  3204. } elsif (length($username) > 50) { # Too long
  3205. print T('UserName must be 50 characters or less. (not saved)'), "<br>\n";
  3206. } else {
  3207. print Ts('UserName %s saved.', $username), '<br>';
  3208. $UserData{'username'} = $username;
  3209. }
  3210. $password = &GetParam("p_password", "");
  3211. if ($password eq "") {
  3212. print T('Password removed.'), '<br>';
  3213. undef $UserData{'password'};
  3214. } elsif ($password ne "*") {
  3215. print T('Password changed.'), '<br>';
  3216. $UserData{'password'} = $password;
  3217. }
  3218. if (($AdminPass ne "") || ($EditPass ne "")) {
  3219. $password = &GetParam("p_adminpw", "");
  3220. if ($password eq "") {
  3221. print T('Administrator password removed.'), '<br>';
  3222. undef $UserData{'adminpw'};
  3223. } elsif ($password ne "*") {
  3224. print T('Administrator password changed.'), '<br>';
  3225. $UserData{'adminpw'} = $password;
  3226. if (&UserIsAdmin()) {
  3227. print T('User has administrative abilities.'), '<br>';
  3228. } elsif (&UserIsEditor()) {
  3229. print T('User has editor abilities.'), '<br>';
  3230. } else {
  3231. print T('User does not have administrative abilities.'), ' ',
  3232. T('(Password does not match administrative password(s).)'),
  3233. '<br>';
  3234. }
  3235. }
  3236. }
  3237. if ($EmailNotify) {
  3238. &UpdatePrefCheckbox("notify");
  3239. &UpdateEmailList();
  3240. }
  3241. &UpdatePrefNumber("rcdays", 0, 0, 999999);
  3242. &UpdatePrefCheckbox("rcnewtop");
  3243. &UpdatePrefCheckbox("rcall");
  3244. &UpdatePrefCheckbox("rcchangehist");
  3245. &UpdatePrefCheckbox("editwide");
  3246. if ($UseDiff) {
  3247. &UpdatePrefCheckbox("norcdiff");
  3248. &UpdatePrefCheckbox("diffrclink");
  3249. &UpdatePrefCheckbox("alldiff");
  3250. &UpdatePrefNumber("defaultdiff", 1, 1, 3);
  3251. }
  3252. &UpdatePrefNumber("rcshowedit", 1, 0, 2);
  3253. &UpdatePrefNumber("tzoffset", 0, -999, 999);
  3254. &UpdatePrefNumber("editrows", 1, 1, 999);
  3255. &UpdatePrefNumber("editcols", 1, 1, 999);
  3256. print T('Server time:'), ' ', &TimeToText($Now-$TimeZoneOffset), '<br>';
  3257. $TimeZoneOffset = &GetParam("tzoffset", 0) * (60 * 60);
  3258. print T('Local time:'), ' ', &TimeToText($Now), '<br>';
  3259. $stylesheet = &GetParam('p_stylesheet', '');
  3260. if ($stylesheet eq '') {
  3261. if (&GetParam('stylesheet', '') ne '') {
  3262. print T('StyleSheet URL removed.'), '<br>';
  3263. }
  3264. undef $UserData{'stylesheet'};
  3265. } else {
  3266. $stylesheet =~ s/[">]//g; # Remove characters that would cause problems
  3267. $UserData{'stylesheet'} = $stylesheet;
  3268. print T('StyleSheet setting saved.'), '<br>';
  3269. }
  3270. &SaveUserData();
  3271. print '<b>', T('Preferences saved.'), '</b>';
  3272. print &GetCommonFooter();
  3273. }
  3274. # add or remove email address from preferences to $EmailFile
  3275. sub UpdateEmailList {
  3276. my (@old_emails);
  3277. local $/ = "\n"; # don't slurp whole files in this sub.
  3278. if (my $new_email = $UserData{'email'} = &GetParam("p_email", "")) {
  3279. my $notify = $UserData{'notify'};
  3280. if (-f $EmailFile) {
  3281. open(NOTIFY, $EmailFile)
  3282. or die(Ts('Could not read from %s:', $EmailFile) . " $!\n");
  3283. @old_emails = <NOTIFY>;
  3284. close(NOTIFY);
  3285. } else {
  3286. @old_emails = ();
  3287. }
  3288. my $already_in_list = grep /$new_email/, @old_emails;
  3289. if ($notify and (not $already_in_list)) {
  3290. &RequestLock() or die(T('Could not get mail lock'));
  3291. if (!open(NOTIFY, ">>$EmailFile")) {
  3292. &ReleaseLock(); # Don't leave hangling locks
  3293. die(Ts('Could not append to %s:', $EmailFile) . " $!\n");
  3294. }
  3295. print NOTIFY $new_email, "\n";
  3296. close(NOTIFY);
  3297. &ReleaseLock();
  3298. }
  3299. elsif ((not $notify) and $already_in_list) {
  3300. &RequestLock() or die(T('Could not get mail lock'));
  3301. if (!open(NOTIFY, ">$EmailFile")) {
  3302. &ReleaseLock();
  3303. die(Ts('Could not overwrite %s:', "$EmailFile") . " $!\n");
  3304. }
  3305. foreach (@old_emails) {
  3306. print NOTIFY "$_" unless /$new_email/;
  3307. }
  3308. close(NOTIFY);
  3309. &ReleaseLock();
  3310. }
  3311. }
  3312. }
  3313. sub UpdatePrefCheckbox {
  3314. my ($param) = @_;
  3315. my $temp = &GetParam("p_$param", "*");
  3316. $UserData{$param} = 1 if ($temp eq "on");
  3317. $UserData{$param} = 0 if ($temp eq "*");
  3318. # It is possible to skip updating by using another value, like "2"
  3319. }
  3320. sub UpdatePrefNumber {
  3321. my ($param, $integer, $min, $max) = @_;
  3322. my $temp = &GetParam("p_$param", "*");
  3323. return if ($temp eq "*");
  3324. $temp =~ s/[^-\d\.]//g;
  3325. $temp =~ s/\..*// if ($integer);
  3326. return if ($temp eq "");
  3327. return if (($temp < $min) || ($temp > $max));
  3328. $UserData{$param} = $temp;
  3329. }
  3330. sub DoIndex {
  3331. print &GetHeader('', T('Index of all pages'), '');
  3332. print '<br>';
  3333. &PrintPageList(&AllPagesList());
  3334. print &GetCommonFooter();
  3335. }
  3336. # Create a new user file/cookie pair
  3337. sub DoNewLogin {
  3338. # Consider warning if cookie already exists
  3339. # (maybe use "replace=1" parameter)
  3340. &CreateUserDir();
  3341. $SetCookie{'id'} = &GetNewUserId();
  3342. $SetCookie{'randkey'} = int(rand(1000000000));
  3343. $SetCookie{'rev'} = 1;
  3344. %UserCookie = %SetCookie;
  3345. $UserID = $SetCookie{'id'};
  3346. # The cookie will be transmitted in the next header
  3347. %UserData = %UserCookie;
  3348. $UserData{'createtime'} = $Now;
  3349. $UserData{'createip'} = $ENV{REMOTE_ADDR};
  3350. &SaveUserData();
  3351. }
  3352. sub DoEnterLogin {
  3353. print &GetHeader('', T('Login'), "");
  3354. print &GetFormStart();
  3355. print &GetHiddenValue('enter_login', 1), "\n";
  3356. print '<br>', T('User ID number:'), ' ',
  3357. $q->textfield(-name=>'p_userid', -value=>'',
  3358. -size=>15, -maxlength=>50);
  3359. print '<br>', T('Password:'), ' ',
  3360. $q->password_field(-name=>'p_password', -value=>'',
  3361. -size=>15, -maxlength=>50);
  3362. print '<br>', $q->submit(-name=>'Login', -value=>T('Login')), "\n";
  3363. print $q->endform;
  3364. if (!&GetParam('embed', $EmbedWiki)) {
  3365. print '<div class=wikifooter>';
  3366. print "<hr class=wikilinefooter>\n";
  3367. print &GetGotoBar('');
  3368. print '</div>';
  3369. }
  3370. print &GetMinimumFooter();
  3371. }
  3372. sub DoLogin {
  3373. my ($uid, $password, $success);
  3374. $success = 0;
  3375. $uid = &GetParam("p_userid", "");
  3376. $uid =~ s/\D//g;
  3377. $password = &GetParam("p_password", "");
  3378. if (($uid > 199) && ($password ne "") && ($password ne "*")) {
  3379. $UserID = $uid;
  3380. &LoadUserData();
  3381. if ($UserID > 199) {
  3382. if (defined($UserData{'password'}) &&
  3383. ($UserData{'password'} eq $password)) {
  3384. $SetCookie{'id'} = $uid;
  3385. $SetCookie{'randkey'} = $UserData{'randkey'};
  3386. $SetCookie{'rev'} = 1;
  3387. $success = 1;
  3388. }
  3389. }
  3390. }
  3391. print &GetHeader('', T('Login Results'), '');
  3392. if ($success) {
  3393. print Ts('Login for user ID %s complete.', $uid);
  3394. } else {
  3395. print Ts('Login for user ID %s failed.', $uid);
  3396. }
  3397. if (!&GetParam('embed', $EmbedWiki)) {
  3398. print '<div class=wikifooter>';
  3399. print "<hr class=wikilinefooter>\n";
  3400. print &GetGotoBar('');
  3401. print '</div>';
  3402. }
  3403. print &GetMinimumFooter();
  3404. }
  3405. sub GetNewUserId {
  3406. my ($id);
  3407. $id = $StartUID;
  3408. while (-f &UserDataFilename($id+1000)) {
  3409. $id += 1000;
  3410. }
  3411. while (-f &UserDataFilename($id+100)) {
  3412. $id += 100;
  3413. }
  3414. while (-f &UserDataFilename($id+10)) {
  3415. $id += 10;
  3416. }
  3417. &RequestLock() or die(T('Could not get user-ID lock'));
  3418. while (-f &UserDataFilename($id)) {
  3419. $id++;
  3420. }
  3421. &WriteStringToFile(&UserDataFilename($id), "lock"); # reserve the ID
  3422. &ReleaseLock();
  3423. return $id;
  3424. }
  3425. # Consider user-level lock?
  3426. sub SaveUserData {
  3427. my ($userFile, $data);
  3428. &CreateUserDir();
  3429. $userFile = &UserDataFilename($UserID);
  3430. $data = join($FS1, %UserData);
  3431. &WriteStringToFile($userFile, $data);
  3432. }
  3433. sub CreateUserDir {
  3434. my ($n, $subdir);
  3435. if (!(-d "$UserDir/0")) {
  3436. &CreateDir($UserDir);
  3437. foreach $n (0..9) {
  3438. $subdir = "$UserDir/$n";
  3439. &CreateDir($subdir);
  3440. }
  3441. }
  3442. }
  3443. sub DoSearch {
  3444. my ($string) = @_;
  3445. if ($string eq '') {
  3446. &DoIndex();
  3447. return;
  3448. }
  3449. print &GetHeader('', &QuoteHtml(Ts('Search for: %s', $string)), '');
  3450. print '<br>';
  3451. &PrintPageList(&SearchTitleAndBody($string));
  3452. print &GetCommonFooter();
  3453. }
  3454. sub DoBackLinks {
  3455. my ($string) = @_;
  3456. print &GetHeader('', &QuoteHtml(Ts('Backlinks for: %s', $string)), '');
  3457. print '<br>';
  3458. # At this time the backlinks are mostly a renamed search.
  3459. # An initial attempt to match links only failed on subpages and free links.
  3460. # Escape some possibly problematic characters:
  3461. $string =~ s/([-'().,])/\\$1/g;
  3462. &PrintPageList(&SearchTitleAndBody($string));
  3463. print &GetCommonFooter();
  3464. }
  3465. sub PrintPageList {
  3466. my $pagename;
  3467. print "<h2>", Ts('%s pages found:', ($#_ + 1)), "</h2>\n";
  3468. foreach $pagename (@_) {
  3469. print ".... " if ($pagename =~ m|/|);
  3470. print &GetPageLink($pagename), "<br>\n";
  3471. }
  3472. }
  3473. sub DoLinks {
  3474. print &GetHeader('', &QuoteHtml(T('Full Link List')), '');
  3475. print "<hr><pre>\n\n\n\n\n"; # Extra lines to get below the logo
  3476. &PrintLinkList(&GetFullLinkList());
  3477. print "</pre>\n";
  3478. print &GetCommonFooter();
  3479. }
  3480. sub PrintLinkList {
  3481. my ($pagelines, $page, $names, $editlink);
  3482. my ($link, $extra, @links, %pgExists);
  3483. %pgExists = ();
  3484. foreach $page (&AllPagesList()) {
  3485. $pgExists{$page} = 1;
  3486. }
  3487. $names = &GetParam("names", 1);
  3488. $editlink = &GetParam("editlink", 0);
  3489. foreach $pagelines (@_) {
  3490. @links = ();
  3491. foreach $page (split(' ', $pagelines)) {
  3492. if ($page =~ /\:/) { # URL or InterWiki form
  3493. if ($page =~ /$UrlPattern/) {
  3494. ($link, $extra) = &UrlLink($page, 0); # No images
  3495. } else {
  3496. ($link, $extra) = &InterPageLink($page, 0); # No images
  3497. }
  3498. } else {
  3499. if ($pgExists{$page}) {
  3500. $link = &GetPageLink($page);
  3501. } else {
  3502. $link = $page;
  3503. if ($editlink) {
  3504. $link .= &GetEditLink($page, "?");
  3505. }
  3506. }
  3507. }
  3508. push(@links, $link);
  3509. }
  3510. if (!$names) {
  3511. shift(@links);
  3512. }
  3513. print join(' ', @links), "\n";
  3514. }
  3515. }
  3516. sub GetFullLinkList {
  3517. my ($name, $unique, $sort, $exists, $empty, $link, $search);
  3518. my ($pagelink, $interlink, $urllink);
  3519. my (@found, @links, @newlinks, @pglist, %pgExists, %seen, $main);
  3520. $unique = &GetParam("unique", 1);
  3521. $sort = &GetParam("sort", 1);
  3522. $pagelink = &GetParam("page", 1);
  3523. $interlink = &GetParam("inter", 0);
  3524. $urllink = &GetParam("url", 0);
  3525. $exists = &GetParam("exists", 2);
  3526. $empty = &GetParam("empty", 0);
  3527. $search = &GetParam("search", "");
  3528. if (($interlink == 2) || ($urllink == 2)) {
  3529. $pagelink = 0;
  3530. }
  3531. %pgExists = ();
  3532. @pglist = &AllPagesList();
  3533. foreach $name (@pglist) {
  3534. $pgExists{$name} = 1;
  3535. }
  3536. %seen = ();
  3537. foreach $name (@pglist) {
  3538. @newlinks = ();
  3539. if ($unique != 2) {
  3540. %seen = ();
  3541. }
  3542. @links = &GetPageLinks($name, $pagelink, $interlink, $urllink);
  3543. if ($UseSubpage) {
  3544. $main = $name;
  3545. $main =~ s/\/.*//;
  3546. }
  3547. foreach $link (@links) {
  3548. if ($UseSubpage && ($link =~ /^\//)) {
  3549. $link = $main . $link;
  3550. }
  3551. $seen{$link}++;
  3552. if (($unique > 0) && ($seen{$link} != 1)) {
  3553. next;
  3554. }
  3555. if (($exists == 0) && ($pgExists{$link} == 1)) {
  3556. next;
  3557. }
  3558. if (($exists == 1) && ($pgExists{$link} != 1)) {
  3559. next;
  3560. }
  3561. if (($search ne "") && !($link =~ /$search/)) {
  3562. next;
  3563. }
  3564. push(@newlinks, $link);
  3565. }
  3566. @links = @newlinks;
  3567. if ($sort) {
  3568. @links = sort(@links);
  3569. }
  3570. unshift (@links, $name);
  3571. if ($empty || ($#links > 0)) { # If only one item, list is empty.
  3572. push(@found, join(' ', @links));
  3573. }
  3574. }
  3575. return @found;
  3576. }
  3577. sub GetPageLinks {
  3578. my ($name, $pagelink, $interlink, $urllink) = @_;
  3579. my ($text, @links);
  3580. @links = ();
  3581. &OpenPage($name);
  3582. &OpenDefaultText();
  3583. $text = $Text{'text'};
  3584. $text =~ s/<html>((.|\n)*?)<\/html>/ /ig;
  3585. $text =~ s/<nowiki>(.|\n)*?\<\/nowiki>/ /ig;
  3586. $text =~ s/<pre>(.|\n)*?\<\/pre>/ /ig;
  3587. $text =~ s/<code>(.|\n)*?\<\/code>/ /ig;
  3588. if ($interlink) {
  3589. $text =~ s/''+/ /g; # Quotes can adjacent to inter-site links
  3590. $text =~ s/$InterLinkPattern/push(@links, &StripUrlPunct($1)), ' '/ge;
  3591. } else {
  3592. $text =~ s/$InterLinkPattern/ /g;
  3593. }
  3594. if ($urllink) {
  3595. $text =~ s/''+/ /g; # Quotes can adjacent to URLs
  3596. $text =~ s/$UrlPattern/push(@links, &StripUrlPunct($1)), ' '/ge;
  3597. } else {
  3598. $text =~ s/$UrlPattern/ /g;
  3599. }
  3600. if ($pagelink) {
  3601. if ($FreeLinks) {
  3602. my $fl = $FreeLinkPattern;
  3603. $text =~ s/\[\[$fl\|[^\]]+\]\]/push(@links, &FreeToNormal($1)), ' '/ge;
  3604. $text =~ s/\[\[$fl\]\]/push(@links, &FreeToNormal($1)), ' '/ge;
  3605. }
  3606. if ($WikiLinks) {
  3607. $text =~ s/$LinkPattern/push(@links, &StripUrlPunct($1)), ' '/ge;
  3608. }
  3609. }
  3610. return @links;
  3611. }
  3612. sub DoPost {
  3613. my ($editDiff, $old, $newAuthor, $pgtime, $oldrev, $preview, $user);
  3614. my $string = &GetParam("text", undef);
  3615. my $id = &GetParam("title", "");
  3616. my $summary = &GetParam("summary", "");
  3617. my $oldtime = &GetParam("oldtime", "");
  3618. my $oldconflict = &GetParam("oldconflict", "");
  3619. my $isEdit = 0;
  3620. my $editTime = $Now;
  3621. my $authorAddr = $ENV{REMOTE_ADDR};
  3622. if ($FreeLinks) {
  3623. $id = &FreeToNormal($id);
  3624. }
  3625. if (!&UserCanEdit($id, 1)) {
  3626. # This is an internal interface--we don't need to explain
  3627. &ReportError(Ts('Editing not allowed for %s.', $id));
  3628. return;
  3629. }
  3630. if (($id eq 'SampleUndefinedPage') ||
  3631. ($id eq T('SampleUndefinedPage')) ||
  3632. ($id eq 'Sample_Undefined_Page') ||
  3633. ($id eq T('Sample_Undefined_Page'))) {
  3634. &ReportError(Ts('%s cannot be defined.', $id));
  3635. return;
  3636. }
  3637. $string = &RemoveFS($string);
  3638. $summary = &RemoveFS($summary);
  3639. $summary =~ s/[\r\n]//g;
  3640. if (length($summary) > 300) { # Too long (longer than form allows)
  3641. $summary = substr($summary, 0, 300);
  3642. }
  3643. # Add a newline to the end of the string (if it doesn't have one)
  3644. $string .= "\n" if (!($string =~ /\n$/));
  3645. # Lock before getting old page to prevent races
  3646. # Consider extracting lock section into sub, and eval-wrap it?
  3647. # (A few called routines can die, leaving locks.)
  3648. if ($LockCrash) {
  3649. &RequestLock() or die(T('Could not get editing lock'));
  3650. } else {
  3651. if (!&RequestLock()) {
  3652. &ForceReleaseLock('main');
  3653. }
  3654. # Clear all other locks.
  3655. &ForceReleaseLock('cache');
  3656. &ForceReleaseLock('diff');
  3657. &ForceReleaseLock('index');
  3658. }
  3659. &OpenPage($id);
  3660. &OpenDefaultText();
  3661. $old = $Text{'text'};
  3662. $oldrev = $Section{'revision'};
  3663. $pgtime = $Section{'ts'};
  3664. $preview = 0;
  3665. $preview = 1 if (&GetParam("Preview", "") ne "");
  3666. if (!$preview && ($old eq $string)) { # No changes (ok for preview)
  3667. &ReleaseLock();
  3668. &ReBrowsePage($id, "", 1);
  3669. return;
  3670. }
  3671. if (($UserID > 399) || ($Section{'id'} > 399)) {
  3672. $newAuthor = ($UserID ne $Section{'id'}); # known user(s)
  3673. } else {
  3674. $newAuthor = ($Section{'ip'} ne $authorAddr); # hostname fallback
  3675. }
  3676. $newAuthor = 1 if ($oldrev == 0); # New page
  3677. $newAuthor = 0 if (!$newAuthor); # Standard flag form, not empty
  3678. # Detect editing conflicts and resubmit edit
  3679. if (($oldrev > 0) && ($newAuthor && ($oldtime != $pgtime))) {
  3680. &ReleaseLock();
  3681. if ($oldconflict > 0) { # Conflict again...
  3682. &DoEdit($id, 2, $pgtime, $string, $preview);
  3683. } else {
  3684. &DoEdit($id, 1, $pgtime, $string, $preview);
  3685. }
  3686. return;
  3687. }
  3688. if ($preview) {
  3689. &ReleaseLock();
  3690. &DoEdit($id, 0, $pgtime, $string, 1);
  3691. return;
  3692. }
  3693. $user = &GetParam("username", "");
  3694. # If the person doing editing chooses, send out email notification
  3695. if ($EmailNotify) {
  3696. &EmailNotify($id, $user) if &GetParam("do_email_notify", "") eq 'on';
  3697. }
  3698. if (&GetParam("recent_edit", "") eq 'on') {
  3699. $isEdit = 1;
  3700. }
  3701. if (!$isEdit) {
  3702. &SetPageCache('oldmajor', $Section{'revision'});
  3703. }
  3704. if ($newAuthor) {
  3705. &SetPageCache('oldauthor', $Section{'revision'});
  3706. }
  3707. &SaveKeepSection();
  3708. &ExpireKeepFile();
  3709. if ($UseDiff) {
  3710. &UpdateDiffs($id, $editTime, $old, $string, $isEdit, $newAuthor);
  3711. }
  3712. $Text{'text'} = $string;
  3713. $Text{'minor'} = $isEdit;
  3714. $Text{'newauthor'} = $newAuthor;
  3715. $Text{'summary'} = $summary;
  3716. $Section{'host'} = &GetRemoteHost(1);
  3717. &SaveDefaultText();
  3718. &SavePage();
  3719. &WriteRcLog($id, $summary, $isEdit, $editTime, $Section{'revision'},
  3720. $user, $Section{'host'});
  3721. if ($UseCache) {
  3722. &UnlinkHtmlCache($id); # Old cached copy is invalid
  3723. if ($Page{'revision'} < 2) { # If this is a new page...
  3724. &NewPageCacheClear($id); # ...uncache pages linked to this one.
  3725. }
  3726. }
  3727. if ($UseIndex && ($Page{'revision'} == 1)) {
  3728. unlink($IndexFile); # Regenerate index on next request
  3729. }
  3730. &ReleaseLock();
  3731. &ReBrowsePage($id, "", 1);
  3732. }
  3733. sub UpdateDiffs {
  3734. my ($id, $editTime, $old, $new, $isEdit, $newAuthor) = @_;
  3735. my ($editDiff, $oldMajor, $oldAuthor);
  3736. $editDiff = &GetDiff($old, $new, 0); # 0 = already in lock
  3737. $oldMajor = &GetPageCache('oldmajor');
  3738. $oldAuthor = &GetPageCache('oldauthor');
  3739. if ($UseDiffLog) {
  3740. &WriteDiff($id, $editTime, $editDiff);
  3741. }
  3742. &SetPageCache('diff_default_minor', $editDiff);
  3743. if ($isEdit || !$newAuthor) {
  3744. &OpenKeptRevisions('text_default');
  3745. }
  3746. if (!$isEdit) {
  3747. &SetPageCache('diff_default_major', "1");
  3748. } else {
  3749. &SetPageCache('diff_default_major', &GetKeptDiff($new, $oldMajor, 0));
  3750. }
  3751. if ($newAuthor) {
  3752. &SetPageCache('diff_default_author', "1");
  3753. } elsif ($oldMajor == $oldAuthor) {
  3754. &SetPageCache('diff_default_author', "2");
  3755. } else {
  3756. &SetPageCache('diff_default_author', &GetKeptDiff($new, $oldAuthor, 0));
  3757. }
  3758. }
  3759. # Translation note: the email messages are still sent in English
  3760. # Send an email message.
  3761. sub SendEmail {
  3762. my ($to, $from, $reply, $subject, $message) = @_;
  3763. # sendmail options:
  3764. # -odq : send mail to queue (i.e. later when convenient)
  3765. # -oi : do not wait for "." line to exit
  3766. # -t : headers determine recipient.
  3767. open (SENDMAIL, "| $SendMail -oi -t ") or die "Can't send email: $!\n";
  3768. print SENDMAIL <<"EOF";
  3769. From: $from
  3770. To: $to
  3771. Reply-to: $reply
  3772. Subject: $subject\n
  3773. $message
  3774. EOF
  3775. close(SENDMAIL) or warn "sendmail didn't close nicely";
  3776. }
  3777. ## Email folks who want to know a note that a page has been modified. - JimM.
  3778. sub EmailNotify {
  3779. local $/ = "\n"; # don't slurp whole files in this sub.
  3780. if ($EmailNotify) {
  3781. my ($id, $user) = @_;
  3782. if ($user) {
  3783. $user = " by $user";
  3784. }
  3785. my $address;
  3786. return if (!-f $EmailFile); # No notifications yet
  3787. open(EMAIL, $EmailFile)
  3788. or die "Can't open $EmailFile: $!\n";
  3789. $address = join ",", <EMAIL>;
  3790. $address =~ s/\n//g;
  3791. close(EMAIL);
  3792. my $home_url = $q->url();
  3793. my $page_url = $home_url . &ScriptLinkChar() . &UriEscape($id);
  3794. my $pref_url = $home_url . &ScriptLinkChar() . "action=editprefs";
  3795. my $editors_summary = $q->param("summary");
  3796. if (($editors_summary eq "*") or ($editors_summary eq "")){
  3797. $editors_summary = "";
  3798. }
  3799. else {
  3800. $editors_summary = "\n Summary: $editors_summary";
  3801. }
  3802. my $content = <<"END_MAIL_CONTENT";
  3803. The $SiteName page $id at
  3804. $page_url
  3805. has been changed$user to revision $Page{revision}. $editors_summary
  3806. (Replying to this notification will
  3807. send email to the entire mailing list,
  3808. so only do that if you mean to.
  3809. To remove yourself from this list, visit
  3810. $pref_url .)
  3811. END_MAIL_CONTENT
  3812. my $subject = "The $id page at $SiteName has been changed.";
  3813. # I'm setting the "reply-to" field to be the same as the "to:" field
  3814. # which seems appropriate for a mailing list, especially since the
  3815. # $EmailFrom string needn't be a real email address.
  3816. &SendEmail($address, $EmailFrom, $address, $subject, $content);
  3817. }
  3818. }
  3819. sub SearchTitleAndBody {
  3820. my ($string) = @_;
  3821. my ($name, $freeName, @found);
  3822. foreach $name (&AllPagesList()) {
  3823. &OpenPage($name);
  3824. &OpenDefaultText();
  3825. if (($Text{'text'} =~ /$string/i) || ($name =~ /$string/i)) {
  3826. push(@found, $name);
  3827. } elsif ($FreeLinks) {
  3828. if ($name =~ m/_/) {
  3829. $freeName = $name;
  3830. $freeName =~ s/_/ /g;
  3831. if ($freeName =~ /$string/i) {
  3832. push(@found, $name);
  3833. }
  3834. } elsif ($string =~ m/ /) {
  3835. $freeName = $string;
  3836. $freeName =~ s/ /_/g;
  3837. if ($Text{'text'} =~ /$freeName/i) {
  3838. push(@found, $name);
  3839. }
  3840. }
  3841. }
  3842. }
  3843. return @found;
  3844. }
  3845. sub SearchBody {
  3846. my ($string) = @_;
  3847. my ($name, @found);
  3848. foreach $name (&AllPagesList()) {
  3849. &OpenPage($name);
  3850. &OpenDefaultText();
  3851. if ($Text{'text'} =~ /$string/i){
  3852. push(@found, $name);
  3853. }
  3854. }
  3855. return @found;
  3856. }
  3857. sub UnlinkHtmlCache {
  3858. my ($id) = @_;
  3859. my $idFile;
  3860. $idFile = &GetHtmlCacheFile($id);
  3861. if (-f $idFile) {
  3862. unlink($idFile);
  3863. }
  3864. }
  3865. sub NewPageCacheClear {
  3866. my ($id) = @_;
  3867. my $name;
  3868. return if (!$UseCache);
  3869. $id =~ s|.+/|/|; # If subpage, search for just the subpage
  3870. # The following code used to search the body for the $id
  3871. foreach $name (&AllPagesList()) { # Remove all to be safe
  3872. &UnlinkHtmlCache($name);
  3873. }
  3874. }
  3875. # Note: all diff and recent-list operations should be done within locks.
  3876. sub DoUnlock {
  3877. my $LockMessage = T('Normal Unlock.');
  3878. print &GetHeader('', T('Removing edit lock'), '');
  3879. print '<p>', T('This operation may take several seconds...'), "\n";
  3880. if (&ForceReleaseLock('main')) {
  3881. $LockMessage = T('Forced Unlock.');
  3882. }
  3883. &ForceReleaseLock('cache');
  3884. &ForceReleaseLock('diff');
  3885. &ForceReleaseLock('index');
  3886. print "<br><h2>$LockMessage</h2>";
  3887. print &GetCommonFooter();
  3888. }
  3889. # Note: all diff and recent-list operations should be done within locks.
  3890. sub WriteRcLog {
  3891. my ($id, $summary, $isEdit, $editTime, $revision, $name, $rhost) = @_;
  3892. my ($extraTemp, %extra);
  3893. %extra = ();
  3894. $extra{'id'} = $UserID if ($UserID > 0);
  3895. $extra{'name'} = $name if ($name ne "");
  3896. $extra{'revision'} = $revision if ($revision ne "");
  3897. $extraTemp = join($FS2, %extra);
  3898. # The two fields at the end of a line are kind and extension-hash
  3899. my $rc_line = join($FS3, $editTime, $id, $summary,
  3900. $isEdit, $rhost, "0", $extraTemp);
  3901. if (!open(OUT, ">>$RcFile")) {
  3902. die(Ts('%s log error:', $RCName) . " $!");
  3903. }
  3904. print OUT $rc_line . "\n";
  3905. close(OUT);
  3906. }
  3907. sub WriteDiff {
  3908. my ($id, $editTime, $diffString) = @_;
  3909. open (OUT, ">>$DataDir/diff_log") or die(T('can not write diff_log'));
  3910. print OUT "------\n" . $id . "|" . $editTime . "\n";
  3911. print OUT $diffString;
  3912. close(OUT);
  3913. }
  3914. # Actions are vetoable if someone edits the page before
  3915. # the keep expiry time. For example, page deletion. If
  3916. # no one edits the page by the time the keep expiry time
  3917. # elapses, then no one has vetoed the last action, and the
  3918. # action is accepted.
  3919. # See http://www.usemod.com/cgi-bin/mb.pl?PageDeletion
  3920. sub ProcessVetos {
  3921. my ($expirets);
  3922. $expirets = $Now - ($KeepDays * 24 * 60 * 60);
  3923. return (0, T('(done)')) unless $Page{'ts'} < $expirets;
  3924. if ($DeletedPage && $Text{'text'} =~ /^\s*$DeletedPage\W*?(\n|$)/o) {
  3925. &DeletePage($OpenPageName, 1, 1);
  3926. return (1, T('(deleted)'));
  3927. }
  3928. if ($ReplaceFile && $Text{'text'} =~ /^\s*$ReplaceFile\:\s*(\S+)/o) {
  3929. my $fname = $1;
  3930. # Only replace an allowed, existing file.
  3931. if ((grep {$_ eq $fname} @ReplaceableFiles) && -e $fname) {
  3932. if ($Text{'text'} =~ /.*<pre>.*?\n(.*?)\s*<\/pre>/ims)
  3933. {
  3934. my $string = $1;
  3935. $string =~ s/\r\n/\n/gms;
  3936. open (OUT, ">$fname") or return 0;
  3937. print OUT $string;
  3938. close OUT;
  3939. return (0, T('(replaced)'));
  3940. }
  3941. }
  3942. }
  3943. return (0, T('(done)'));
  3944. }
  3945. sub DoMaintain {
  3946. my ($name, $fname, $data, $message, $status);
  3947. print &GetHeader('', T('Maintenance on all pages'), '');
  3948. print "<br>";
  3949. $fname = "$DataDir/maintain";
  3950. if (!&UserIsAdmin()) {
  3951. if ((-f $fname) && ((-M $fname) < 0.5)) {
  3952. print T('Maintenance not done.'), ' ';
  3953. print T('(Maintenance can only be done once every 12 hours.)');
  3954. print ' ', T('Remove the "maintain" file or wait.');
  3955. print &GetCommonFooter();
  3956. return;
  3957. }
  3958. }
  3959. &RequestLock() or die(T('Could not get maintain-lock'));
  3960. foreach $name (&AllPagesList()) {
  3961. &OpenPage($name);
  3962. &OpenDefaultText();
  3963. ($status, $message) = &ProcessVetos();
  3964. &ExpireKeepFile() unless $status;
  3965. print ".... " if ($name =~ m|/|);
  3966. print &GetPageLink($name);
  3967. print " $message<br>\n";
  3968. }
  3969. &WriteStringToFile($fname, Ts('Maintenance done at %s', &TimeToText($Now)));
  3970. &ReleaseLock();
  3971. # Do any rename/deletion commands
  3972. # (Must be outside lock because it will grab its own lock)
  3973. $fname = "$DataDir/editlinks";
  3974. if (-f $fname) {
  3975. $data = &ReadFileOrDie($fname);
  3976. print '<hr>', T('Processing rename/delete commands:'), "<br>\n";
  3977. &UpdateLinksList($data, 1, 1); # Always update RC and links
  3978. unlink("$fname.old");
  3979. rename($fname, "$fname.old");
  3980. }
  3981. if ($MaintTrimRc) {
  3982. &RequestLock() or die(T('Could not get lock for RC maintenance'));
  3983. $status = &TrimRc(); # Consider error messages?
  3984. &ReleaseLock();
  3985. }
  3986. print &GetCommonFooter();
  3987. }
  3988. # Must be called within a lock.
  3989. # Thanks to Alex Schroeder for original code
  3990. sub TrimRc {
  3991. my (@rc, @temp, $starttime, $days, $status, $data, $i, $ts);
  3992. # Determine the number of days to go back
  3993. $days = 0;
  3994. foreach (@RcDays) {
  3995. $days = $_ if $_ > $days;
  3996. }
  3997. $starttime = $Now - $days * 24 * 60 * 60;
  3998. return 1 if (!-f $RcFile); # No work if no file exists
  3999. ($status, $data) = &ReadFile($RcFile);
  4000. if (!$status) {
  4001. print '<p><strong>' . Ts('Could not open %s log file', $RCName)
  4002. . ":</strong> $RcFile<p>"
  4003. . T('Error was') . ":\n<pre>$!</" . "pre>\n" . '<p>';
  4004. return 0;
  4005. }
  4006. # Move the old stuff from rc to temp
  4007. @rc = split(/\n/, $data);
  4008. for ($i = 0; $i < @rc; $i++) {
  4009. ($ts) = split(/$FS3/, $rc[$i]);
  4010. last if ($ts >= $starttime);
  4011. }
  4012. return 1 if ($i < 1); # No lines to move from new to old
  4013. @temp = splice(@rc, 0, $i);
  4014. # Write new files and backups
  4015. if (!open(OUT, ">>$RcOldFile")) {
  4016. print '<p><strong>' . Ts('Could not open %s log file', $RCName)
  4017. . ":</strong> $RcOldFile<p>"
  4018. . T('Error was') . ":\n<pre>$!</" . "pre>\n" . '<p>';
  4019. return 0;
  4020. }
  4021. print OUT join("\n", @temp) . "\n";
  4022. close(OUT);
  4023. &WriteStringToFile($RcFile . '.old', $data);
  4024. $data = join("\n", @rc);
  4025. $data .= "\n" if ($data ne ''); # If no entries, don't add blank line
  4026. &WriteStringToFile($RcFile, $data);
  4027. return 1;
  4028. }
  4029. sub DoMaintainRc {
  4030. print &GetHeader('', T('Maintaining RC log'), '');
  4031. return if (!&UserIsAdminOrError());
  4032. &RequestLock() or die(T('Could not get lock for RC maintenance'));
  4033. if (&TrimRc()) {
  4034. print '<br>' . T('RC maintenance done.') . '<br>';
  4035. } else {
  4036. print '<br>' . T('RC maintenance not done.') . '<br>';
  4037. }
  4038. &ReleaseLock();
  4039. print &GetCommonFooter();
  4040. }
  4041. sub UserIsEditorOrError {
  4042. if (!&UserIsEditor()) {
  4043. print '<p>', T('This operation is restricted to site editors only...');
  4044. print &GetCommonFooter();
  4045. return 0;
  4046. }
  4047. return 1;
  4048. }
  4049. sub UserIsAdminOrError {
  4050. if (!&UserIsAdmin()) {
  4051. print '<p>', T('This operation is restricted to administrators only...');
  4052. print &GetCommonFooter();
  4053. return 0;
  4054. }
  4055. return 1;
  4056. }
  4057. sub DoEditLock {
  4058. my ($fname);
  4059. print &GetHeader('', T('Set or Remove global edit lock'), '');
  4060. return if (!&UserIsAdminOrError());
  4061. $fname = "$DataDir/noedit";
  4062. if (&GetParam("set", 1)) {
  4063. &WriteStringToFile($fname, "editing locked.");
  4064. } else {
  4065. unlink($fname);
  4066. }
  4067. if (-f $fname) {
  4068. print '<p>', T('Edit lock created.'), '<br>';
  4069. } else {
  4070. print '<p>', T('Edit lock removed.'), '<br>';
  4071. }
  4072. print &GetCommonFooter();
  4073. }
  4074. sub DoPageLock {
  4075. my ($fname, $id);
  4076. print &GetHeader('', T('Set or Remove page edit lock'), '');
  4077. # Consider allowing page lock/unlock at editor level?
  4078. return if (!&UserIsAdminOrError());
  4079. $id = &GetParam("id", "");
  4080. if ($id eq "") {
  4081. print '<p>', T('Missing page id to lock/unlock...');
  4082. return;
  4083. }
  4084. return if (!&ValidIdOrDie($id)); # Consider nicer error?
  4085. $fname = &GetLockedPageFile($id);
  4086. if (&GetParam("set", 1)) {
  4087. &WriteStringToFile($fname, "editing locked.");
  4088. } else {
  4089. unlink($fname);
  4090. }
  4091. if (-f $fname) {
  4092. print '<p>', Ts('Lock for %s created.', $id), '<br>';
  4093. } else {
  4094. print '<p>', Ts('Lock for %s removed.', $id), '<br>';
  4095. }
  4096. print &GetCommonFooter();
  4097. }
  4098. sub DoEditBanned {
  4099. my ($banList, $status);
  4100. print &GetHeader('', T('Editing Banned list'), '');
  4101. return if (!&UserIsAdminOrError());
  4102. ($status, $banList) = &ReadFile("$DataDir/banlist");
  4103. $banList = "" if (!$status);
  4104. print &GetFormStart();
  4105. print GetHiddenValue("edit_ban", 1), "\n";
  4106. print "<b>Banned IP/network/host list:</b><br>\n";
  4107. print "<p>Each entry is either a commented line (starting with #), ",
  4108. "or a Perl regular expression (matching either an IP address or ",
  4109. "a hostname). <b>Note:</b> To test the ban on yourself, you must ",
  4110. "give up your admin access (remove password in Preferences).";
  4111. print "<p>Example:<br>",
  4112. "# blocks hosts ending with .foocorp.com<br>",
  4113. "\\.foocorp\\.com\$<br>",
  4114. "# blocks exact IP address<br>",
  4115. "^123\\.21\\.3\\.9\$<br>",
  4116. "# blocks whole 123.21.3.* IP network<br>",
  4117. "^123\\.21\\.3\\.\\d+\$<p>";
  4118. print &GetTextArea('banlist', $banList, 12, 50);
  4119. print "<br>", $q->submit(-name=>'Save'), "\n";
  4120. print $q->endform;
  4121. if (!&GetParam('embed', $EmbedWiki)) {
  4122. print '<div class=wikifooter>';
  4123. print "<hr class=wikilinefooter>\n";
  4124. print &GetGotoBar('');
  4125. print '</div>';
  4126. }
  4127. print &GetMinimumFooter();
  4128. }
  4129. sub DoUpdateBanned {
  4130. my ($newList, $fname);
  4131. print &GetHeader('', T('Updating Banned list'), '');
  4132. return if (!&UserIsAdminOrError());
  4133. $fname = "$DataDir/banlist";
  4134. $newList = &GetParam("banlist", "#Empty file");
  4135. if ($newList eq "") {
  4136. print "<p>", T('Empty banned list or error.');
  4137. print "<p>", T('Resubmit with at least one space character to remove.');
  4138. } elsif ($newList =~ /^\s*$/s) {
  4139. unlink($fname);
  4140. print "<p>", T('Removed banned list');
  4141. } else {
  4142. &WriteStringToFile($fname, $newList);
  4143. print "<p>", T('Updated banned list');
  4144. }
  4145. print &GetCommonFooter();
  4146. }
  4147. # ==== Editing/Deleting pages and links ====
  4148. sub DoEditLinks {
  4149. print &GetHeader('', T('Editing Links'), '');
  4150. if ($AdminDelete) {
  4151. return if (!&UserIsAdminOrError());
  4152. } else {
  4153. return if (!&UserIsEditorOrError());
  4154. }
  4155. print &GetFormStart();
  4156. print GetHiddenValue("edit_links", 1), "\n";
  4157. print "<b>Editing/Deleting page titles:</b><br>\n";
  4158. print "<p>Enter one command on each line. Commands are:<br>",
  4159. "<tt>!PageName</tt> -- deletes the page called PageName<br>\n",
  4160. "<tt>=OldPageName=NewPageName</tt> -- Renames OldPageName ",
  4161. "to NewPageName and updates links to OldPageName.<br>\n",
  4162. "<tt>|OldPageName|NewPageName</tt> -- Changes links to OldPageName ",
  4163. "to NewPageName.",
  4164. " (Used to rename links to non-existing pages.)<br>\n",
  4165. "<b>Note: page names are case-sensitive!</b>\n";
  4166. print &GetTextArea('commandlist', "", 12, 50);
  4167. print $q->checkbox(-name=>"p_changerc", -override=>1, -checked=>1,
  4168. -label=>"Edit $RCName");
  4169. print "<br>\n";
  4170. print $q->checkbox(-name=>"p_changetext", -override=>1, -checked=>1,
  4171. -label=>"Substitute text for rename");
  4172. print "<br>", $q->submit(-name=>'Edit'), "\n";
  4173. print $q->endform;
  4174. if (!&GetParam('embed', $EmbedWiki)) {
  4175. print '<div class=wikifooter>';
  4176. print "<hr class=wikilinefooter>\n";
  4177. print &GetGotoBar('');
  4178. print '</div>';
  4179. }
  4180. print &GetMinimumFooter();
  4181. }
  4182. sub UpdateLinksList {
  4183. my ($commandList, $doRC, $doText) = @_;
  4184. if ($doText) {
  4185. &BuildLinkIndex();
  4186. }
  4187. &RequestLock() or die T('UpdateLinksList could not get main lock');
  4188. unlink($IndexFile) if ($UseIndex);
  4189. foreach (split(/\n/, $commandList)) {
  4190. s/\s+$//g;
  4191. next if (!(/^[=!|]/)); # Only valid commands.
  4192. print "Processing $_<br>\n";
  4193. if (/^\!(.+)/) {
  4194. &DeletePage($1, $doRC, $doText);
  4195. } elsif (/^\=(?:\[\[)?([^]=]+)(?:\]\])?\=(?:\[\[)?([^]=]+)(?:\]\])?/) {
  4196. &RenamePage($1, $2, $doRC, $doText);
  4197. } elsif (/^\|(?:\[\[)?([^]|]+)(?:\]\])?\|(?:\[\[)?([^]|]+)(?:\]\])?/) {
  4198. &RenameTextLinks($1, $2);
  4199. }
  4200. }
  4201. &NewPageCacheClear("."); # Clear cache (needs testing?)
  4202. unlink($IndexFile) if ($UseIndex);
  4203. &ReleaseLock();
  4204. }
  4205. sub BuildLinkIndex {
  4206. my (@pglist, $page, @links, $link, %seen);
  4207. @pglist = &AllPagesList();
  4208. %LinkIndex = ();
  4209. foreach $page (@pglist) {
  4210. &BuildLinkIndexPage($page);
  4211. }
  4212. }
  4213. sub BuildLinkIndexPage {
  4214. my ($page) = @_;
  4215. my (@links, $link, %seen);
  4216. @links = &GetPageLinks($page, 1, 0, 0);
  4217. %seen = ();
  4218. foreach $link (@links) {
  4219. if (defined($LinkIndex{$link})) {
  4220. if (!$seen{$link}) {
  4221. $LinkIndex{$link} .= " " . $page;
  4222. }
  4223. } else {
  4224. $LinkIndex{$link} .= " " . $page;
  4225. }
  4226. $seen{$link} = 1;
  4227. }
  4228. }
  4229. sub DoUpdateLinks {
  4230. my ($commandList, $doRC, $doText);
  4231. print &GetHeader('', T('Updating Links'), '');
  4232. if ($AdminDelete) {
  4233. return if (!&UserIsAdminOrError());
  4234. } else {
  4235. return if (!&UserIsEditorOrError());
  4236. }
  4237. $commandList = &GetParam("commandlist", "");
  4238. $doRC = &GetParam("p_changerc", "0");
  4239. $doRC = 1 if ($doRC eq "on");
  4240. $doText = &GetParam("p_changetext", "0");
  4241. $doText = 1 if ($doText eq "on");
  4242. if ($commandList eq "") {
  4243. print "<p>", T('Empty command list or error.');
  4244. } else {
  4245. &UpdateLinksList($commandList, $doRC, $doText);
  4246. print "<p>", T('Finished command list.');
  4247. }
  4248. print &GetCommonFooter();
  4249. }
  4250. sub EditRecentChanges {
  4251. my ($action, $old, $new) = @_;
  4252. &EditRecentChangesFile($RcFile, $action, $old, $new, 1);
  4253. &EditRecentChangesFile($RcOldFile, $action, $old, $new, 0);
  4254. }
  4255. sub EditRecentChangesFile {
  4256. my ($fname, $action, $old, $new, $printError) = @_;
  4257. my ($status, $fileData, $errorText, $rcline, @rclist);
  4258. my ($outrc, $ts, $page, $junk);
  4259. ($status, $fileData) = &ReadFile($fname);
  4260. if (!$status) {
  4261. # Save error text if needed.
  4262. $errorText = "<p><strong>"
  4263. . Ts('Could not open %s log file:', $RCName)
  4264. . "</strong> $fname"
  4265. . "<p>" . T('Error was:') . "\n<pre>$!</pre>\n";
  4266. print $errorText if ($printError);
  4267. return;
  4268. }
  4269. $outrc = "";
  4270. @rclist = split(/\n/, $fileData);
  4271. foreach $rcline (@rclist) {
  4272. ($ts, $page, $junk) = split(/$FS3/, $rcline);
  4273. if ($page eq $old) {
  4274. if ($action == 1) { # Delete
  4275. ; # Do nothing (don't add line to new RC)
  4276. } elsif ($action == 2) {
  4277. $junk = $rcline;
  4278. $junk =~ s/^(\d+$FS3)$old($FS3)/"$1$new$2"/ge;
  4279. $outrc .= $junk . "\n";
  4280. }
  4281. } else {
  4282. $outrc .= $rcline . "\n";
  4283. }
  4284. }
  4285. &WriteStringToFile($fname . ".old", $fileData); # Backup copy
  4286. &WriteStringToFile($fname, $outrc);
  4287. }
  4288. # Delete and rename must be done inside locks.
  4289. sub DeletePage {
  4290. my ($page, $doRC, $doText) = @_;
  4291. my ($fname, $status);
  4292. $page =~ s/ /_/g;
  4293. $page =~ s/\[+//;
  4294. $page =~ s/\]+//;
  4295. $status = &ValidId($page);
  4296. if ($status ne "") {
  4297. print Tss('Delete-Page: page %1 is invalid, error is: %2', $page, $status)
  4298. . "<br>\n";
  4299. return;
  4300. }
  4301. $fname = &GetPageFile($page);
  4302. unlink($fname) if (-f $fname);
  4303. $fname = $KeepDir . "/" . &GetPageDirectory($page) . "/$page.kp";
  4304. unlink($fname) if (-f $fname);
  4305. unlink($IndexFile) if ($UseIndex);
  4306. &EditRecentChanges(1, $page, "") if ($doRC); # Delete page
  4307. # Currently don't do anything with page text
  4308. }
  4309. # Given text, returns substituted text
  4310. sub SubstituteTextLinks {
  4311. my ($old, $new, $text) = @_;
  4312. # Much of this is taken from the common markup
  4313. %SaveUrl = ();
  4314. $SaveUrlIndex = 0;
  4315. $text =~ s/$FS(\d)/$1/g; # Remove separators (paranoia)
  4316. if ($RawHtml) {
  4317. $text =~ s/(<html>((.|\n)*?)<\/html>)/&StoreRaw($1)/ige;
  4318. }
  4319. $text =~ s/(<pre>((.|\n)*?)<\/pre>)/&StoreRaw($1)/ige;
  4320. $text =~ s/(<code>((.|\n)*?)<\/code>)/&StoreRaw($1)/ige;
  4321. $text =~ s/(<nowiki>((.|\n)*?)<\/nowiki>)/&StoreRaw($1)/ige;
  4322. if ($FreeLinks) {
  4323. $text =~
  4324. s/\[\[$FreeLinkPattern\|([^\]]+)\]\]/&SubFreeLink($1,$2,$old,$new)/geo;
  4325. $text =~ s/\[\[$FreeLinkPattern\]\]/&SubFreeLink($1,"",$old,$new)/geo;
  4326. }
  4327. if ($BracketText) { # Links like [URL text of link]
  4328. $text =~ s/(\[$UrlPattern\s+([^\]]+?)\])/&StoreRaw($1)/geo;
  4329. $text =~ s/(\[$InterLinkPattern\s+([^\]]+?)\])/&StoreRaw($1)/geo;
  4330. }
  4331. $text =~ s/(\[?$UrlPattern\]?)/&StoreRaw($1)/geo;
  4332. $text =~ s/(\[?$InterLinkPattern\]?)/&StoreRaw($1)/geo;
  4333. if ($WikiLinks) {
  4334. $text =~ s/$LinkPattern/&SubWikiLink($1, $old, $new)/geo;
  4335. }
  4336. # Thanks to David Claughton for the following fix
  4337. 1 while $text =~ s/$FS(\d+)$FS/$SaveUrl{$1}/ge; # Restore saved text
  4338. return $text;
  4339. }
  4340. sub SubFreeLink {
  4341. my ($link, $name, $old, $new) = @_;
  4342. my ($oldlink);
  4343. $oldlink = $link;
  4344. $link =~ s/^\s+//;
  4345. $link =~ s/\s+$//;
  4346. if (($link eq $old) || (&FreeToNormal($old) eq &FreeToNormal($link))) {
  4347. $link = $new;
  4348. } else {
  4349. $link = $oldlink; # Preserve spaces if no match
  4350. }
  4351. $link = "[[$link";
  4352. if ($name ne "") {
  4353. $link .= "|$name";
  4354. }
  4355. $link .= "]]";
  4356. return &StoreRaw($link);
  4357. }
  4358. sub SubWikiLink {
  4359. my ($link, $old, $new) = @_;
  4360. my ($newBracket);
  4361. $newBracket = 0;
  4362. if ($link eq $old) {
  4363. $link = $new;
  4364. if (!($new =~ /^$LinkPattern$/)) {
  4365. $link = "[[$link]]";
  4366. }
  4367. }
  4368. return &StoreRaw($link);
  4369. }
  4370. # Rename is mostly copied from expire
  4371. sub RenameKeepText {
  4372. my ($page, $old, $new) = @_;
  4373. my ($fname, $status, $data, @kplist, %tempSection, $changed);
  4374. my ($sectName, $newText);
  4375. $fname = $KeepDir . "/" . &GetPageDirectory($page) . "/$page.kp";
  4376. return if (!(-f $fname));
  4377. ($status, $data) = &ReadFile($fname);
  4378. return if (!$status);
  4379. @kplist = split(/$FS1/, $data, -1); # -1 keeps trailing null fields
  4380. return if (length(@kplist) < 1); # Also empty
  4381. shift(@kplist) if ($kplist[0] eq ""); # First can be empty
  4382. return if (length(@kplist) < 1); # Also empty
  4383. %tempSection = split(/$FS2/, $kplist[0], -1);
  4384. if (!defined($tempSection{'keepts'})) {
  4385. return;
  4386. }
  4387. # First pass: optimize for nothing changed
  4388. $changed = 0;
  4389. foreach (@kplist) {
  4390. %tempSection = split(/$FS2/, $_, -1);
  4391. $sectName = $tempSection{'name'};
  4392. if ($sectName =~ /^(text_)/) {
  4393. %Text = split(/$FS3/, $tempSection{'data'}, -1);
  4394. $newText = &SubstituteTextLinks($old, $new, $Text{'text'});
  4395. $changed = 1 if ($Text{'text'} ne $newText);
  4396. }
  4397. }
  4398. return if (!$changed); # No sections changed
  4399. open (OUT, ">$fname") or return;
  4400. foreach (@kplist) {
  4401. %tempSection = split(/$FS2/, $_, -1);
  4402. $sectName = $tempSection{'name'};
  4403. if ($sectName =~ /^(text_)/) {
  4404. %Text = split(/$FS3/, $tempSection{'data'}, -1);
  4405. $newText = &SubstituteTextLinks($old, $new, $Text{'text'});
  4406. $Text{'text'} = $newText;
  4407. $tempSection{'data'} = join($FS3, %Text);
  4408. print OUT $FS1, join($FS2, %tempSection);
  4409. } else {
  4410. print OUT $FS1, $_;
  4411. }
  4412. }
  4413. close(OUT);
  4414. }
  4415. sub RenameTextLinks {
  4416. my ($old, $new) = @_;
  4417. my ($changed, $file, $page, $section, $oldText, $newText, $status);
  4418. my ($oldCanonical, @pageList);
  4419. $old =~ s/ /_/g;
  4420. $oldCanonical = &FreeToNormal($old);
  4421. $new =~ s/ /_/g;
  4422. $status = &ValidId($old);
  4423. if ($status ne "") {
  4424. print Tss('Rename-Text: old page %1 is invalid, error is: %2', $old, $status)
  4425. . "<br>\n";
  4426. return;
  4427. }
  4428. $status = &ValidId($new);
  4429. if ($status ne "") {
  4430. print Tss('Rename-Text: new page %1 is invalid, error is: %2', $new, $status)
  4431. . "<br>\n";
  4432. return;
  4433. }
  4434. $old =~ s/_/ /g;
  4435. $new =~ s/_/ /g;
  4436. # Note: the LinkIndex must be built prior to this routine
  4437. return if (!defined($LinkIndex{$oldCanonical}));
  4438. @pageList = split(' ', $LinkIndex{$oldCanonical});
  4439. foreach $page (@pageList) {
  4440. $changed = 0;
  4441. &OpenPage($page);
  4442. foreach $section (keys %Page) {
  4443. if ($section =~ /^text_/) {
  4444. &OpenSection($section);
  4445. %Text = split(/$FS3/, $Section{'data'}, -1);
  4446. $oldText = $Text{'text'};
  4447. $newText = &SubstituteTextLinks($old, $new, $oldText);
  4448. if ($oldText ne $newText) {
  4449. $Text{'text'} = $newText;
  4450. $Section{'data'} = join($FS3, %Text);
  4451. $Page{$section} = join($FS2, %Section);
  4452. $changed = 1;
  4453. }
  4454. } elsif ($section =~ /^cache_diff/) {
  4455. $oldText = $Page{$section};
  4456. $newText = &SubstituteTextLinks($old, $new, $oldText);
  4457. if ($oldText ne $newText) {
  4458. $Page{$section} = $newText;
  4459. $changed = 1;
  4460. }
  4461. }
  4462. # Add other text-sections (categories) here
  4463. }
  4464. if ($changed) {
  4465. $file = &GetPageFile($page);
  4466. &WriteStringToFile($file, join($FS1, %Page));
  4467. }
  4468. &RenameKeepText($page, $old, $new);
  4469. }
  4470. }
  4471. sub RenamePage {
  4472. my ($old, $new, $doRC, $doText) = @_;
  4473. my ($oldfname, $newfname, $oldkeep, $newkeep, $status);
  4474. $old =~ s/ /_/g;
  4475. $new = &FreeToNormal($new);
  4476. $status = &ValidId($old);
  4477. if ($status ne "") {
  4478. print Tss('Rename: old page %1 is invalid, error is: %2', $old, $status)
  4479. . "<br>\n";
  4480. return;
  4481. }
  4482. $status = &ValidId($new);
  4483. if ($status ne "") {
  4484. print Tss('Rename: new page %1 is invalid, error is: %2', $new, $status)
  4485. . "<br>\n";
  4486. return;
  4487. }
  4488. $newfname = &GetPageFile($new);
  4489. if (-f $newfname) {
  4490. print Ts('Rename: new page %s already exists--not renamed.', $new)
  4491. . "<br>\n";
  4492. return;
  4493. }
  4494. $oldfname = &GetPageFile($old);
  4495. if (!(-f $oldfname)) {
  4496. print Ts('Rename: old page %s does not exist--nothing done.', $old)
  4497. . "<br>\n";
  4498. return;
  4499. }
  4500. &CreatePageDir($PageDir, $new); # It might not exist yet
  4501. rename($oldfname, $newfname);
  4502. &CreatePageDir($KeepDir, $new);
  4503. $oldkeep = $KeepDir . "/" . &GetPageDirectory($old) . "/$old.kp";
  4504. $newkeep = $KeepDir . "/" . &GetPageDirectory($new) . "/$new.kp";
  4505. unlink($newkeep) if (-f $newkeep); # Clean up if needed.
  4506. rename($oldkeep, $newkeep);
  4507. unlink($IndexFile) if ($UseIndex);
  4508. &EditRecentChanges(2, $old, $new) if ($doRC);
  4509. if ($doText) {
  4510. &BuildLinkIndexPage($new); # Keep index up-to-date
  4511. &RenameTextLinks($old, $new);
  4512. }
  4513. }
  4514. sub DoShowVersion {
  4515. print &GetHeader('', T('Displaying Wiki Version'), '');
  4516. print "<p>UseModWiki version 1.0.4</p>\n";
  4517. print &GetCommonFooter();
  4518. }
  4519. # Thanks to Phillip Riley for original code
  4520. sub DoDeletePage {
  4521. my ($id) = @_;
  4522. return if (!&ValidIdOrDie($id));
  4523. print &GetHeader('', Ts('Delete %s', $id), '');
  4524. return if (!&UserIsAdminOrError());
  4525. if ($ConfirmDel && !&GetParam('confirm', 0)) {
  4526. print '<p>';
  4527. print Ts('Confirm deletion of %s by following this link:', $id);
  4528. print '<br>' . &GetDeleteLink($id, T('Confirm Delete'), 1);
  4529. print '</p>';
  4530. print &GetCommonFooter();
  4531. return;
  4532. }
  4533. print '<p>';
  4534. if ($id eq $HomePage) {
  4535. print Ts('%s can not be deleted.', $HomePage);
  4536. } else {
  4537. if (-f &GetLockedPageFile($id)) {
  4538. print Ts('%s can not be deleted because it is locked.', $id);
  4539. } else {
  4540. # Must lock because of RC-editing
  4541. &RequestLock() or die(T('Could not get editing lock'));
  4542. DeletePage($id, 1, 1);
  4543. &ReleaseLock();
  4544. print Ts('%s has been deleted.', $id);
  4545. }
  4546. }
  4547. print '</p>';
  4548. print &GetCommonFooter();
  4549. }
  4550. # Thanks to Ross Kowalski and Iliyan Jeliazkov for original uploading code
  4551. sub DoUpload {
  4552. print &GetHeader('', T('File Upload Page'), '');
  4553. if (!$AllUpload) {
  4554. return if (!&UserIsEditorOrError());
  4555. }
  4556. print '<p>' . Ts('The current upload size limit is %s.', $MaxPost) . ' '
  4557. . Ts('Change the %s variable to increase this limit.', '$MaxPost');
  4558. print '</p><br>';
  4559. print '<FORM METHOD="post" ACTION="' . $ScriptName
  4560. . '" ENCTYPE="multipart/form-data">';
  4561. print '<input type="hidden" name="upload" value="1" />';
  4562. print T('File to Upload:'), ' <INPUT TYPE="file" NAME="file"><br><BR>';
  4563. print '<INPUT TYPE="submit" NAME="Submit" VALUE="', T('Upload'), '">';
  4564. print '</FORM>';
  4565. print &GetCommonFooter();
  4566. }
  4567. sub SaveUpload {
  4568. my ($filename, $printFilename, $uploadFilehandle);
  4569. print &GetHeader('', T('Upload Finished'), '');
  4570. if (!$AllUpload) {
  4571. return if (!&UserIsEditorOrError());
  4572. }
  4573. $UploadDir .= '/' if (substr($UploadDir, -1, 1) ne '/'); # End with /
  4574. $UploadUrl .= '/' if (substr($UploadUrl, -1, 1) ne '/'); # End with /
  4575. $filename = $q->param('file');
  4576. $filename =~ s/.*[\/\\](.*)/$1/; # Only name after last \ or /
  4577. $uploadFilehandle = $q->upload('file');
  4578. open UPLOADFILE, ">$UploadDir$filename";
  4579. binmode UPLOADFILE;
  4580. while (<$uploadFilehandle>) { print UPLOADFILE; }
  4581. close UPLOADFILE;
  4582. print T('The wiki link to your file is:') . "\n<br><BR>";
  4583. $printFilename = $filename;
  4584. $printFilename =~ s/ /\%20/g; # Replace spaces with escaped spaces
  4585. print "upload:" . $printFilename . "<BR><BR>\n";
  4586. if ($filename =~ /$ImageExtensions$/i) {
  4587. print '<HR><img src="' . $UploadUrl . $filename . '">' . "\n";
  4588. }
  4589. print &GetCommonFooter();
  4590. }
  4591. sub ConvertFsFile {
  4592. my ($oldFS, $newFS, $fname) = @_;
  4593. my ($oldData, $newData, $status);
  4594. return if (!-f $fname); # Convert only existing regular files
  4595. ($status, $oldData) = &ReadFile($fname);
  4596. if (!$status) {
  4597. print '<br><strong>' . Ts('Could not open file %s', $fname)
  4598. . ':</strong>' . T('Error was') . ":\n<pre>$!</pre>\n" . '<br>';
  4599. return;
  4600. }
  4601. $newData = $oldData;
  4602. $newData =~ s/$oldFS(\d)/$newFS . $1/ge;
  4603. return if ($oldData eq $newData); # Do not write if the same
  4604. &WriteStringToFile($fname, $newData);
  4605. # print $fname . '<br>'; # progress report
  4606. }
  4607. # Converts up to 3 dirs deep (like page/A/Apple/subpage.db)
  4608. # Note that top level directory (page/keep/user) contains only dirs
  4609. sub ConvertFsDir {
  4610. my ($oldFS, $newFS, $topDir) = @_;
  4611. my (@dirs, @files, @subFiles, $dir, $file, $subFile, $fname, $subFname);
  4612. opendir(DIRLIST, $topDir);
  4613. @dirs = readdir(DIRLIST);
  4614. closedir(DIRLIST);
  4615. @dirs = sort(@dirs);
  4616. foreach $dir (@dirs) {
  4617. next if (substr($dir, 0, 1) eq '.'); # No ., .., or .dirs
  4618. next if (!-d "$topDir/$dir"); # Top level directories only
  4619. next if (-f "$topDir/$dir.cvt"); # Skip if already converted
  4620. opendir(DIRLIST, "$topDir/$dir");
  4621. @files = readdir(DIRLIST);
  4622. closedir(DIRLIST);
  4623. foreach $file (@files) {
  4624. next if (($file eq '.') || ($file eq '..'));
  4625. $fname = "$topDir/$dir/$file";
  4626. if (-f $fname) {
  4627. # print $fname . '<br>'; # progress
  4628. &ConvertFsFile($oldFS, $newFS, $fname);
  4629. } elsif (-d $fname) {
  4630. opendir(DIRLIST, $fname);
  4631. @subFiles = readdir(DIRLIST);
  4632. closedir(DIRLIST);
  4633. foreach $subFile (@subFiles) {
  4634. next if (($subFile eq '.') || ($subFile eq '..'));
  4635. $subFname = "$fname/$subFile";
  4636. if (-f $subFname) {
  4637. # print $subFname . '<br>'; # progress
  4638. &ConvertFsFile($oldFS, $newFS, $subFname);
  4639. }
  4640. }
  4641. }
  4642. }
  4643. &WriteStringToFile("$topDir/$dir.cvt", 'converted');
  4644. }
  4645. }
  4646. sub ConvertFsCleanup {
  4647. my ($topDir) = @_;
  4648. my (@dirs, $dir);
  4649. opendir(DIRLIST, $topDir);
  4650. @dirs = readdir(DIRLIST);
  4651. closedir(DIRLIST);
  4652. foreach $dir (@dirs) {
  4653. next if (substr($dir, 0, 1) eq '.'); # No ., .., or .dirs
  4654. next if (!-f "$topDir/$dir"); # Remove only files...
  4655. next unless ($dir =~ m/\.cvt$/); # ...that end with .cvt
  4656. unlink "$topDir/$dir";
  4657. }
  4658. }
  4659. sub DoConvert {
  4660. my $oldFS = "\xb3";
  4661. my $newFS = "\x1e\xff\xfe\x1e";
  4662. print &GetHeader('', T('Convert wiki DB'), '');
  4663. return if (!&UserIsAdminOrError());
  4664. if ($FS ne $newFS) {
  4665. print Ts('You must change the %s option before converting the wiki DB.',
  4666. '$NewFS') . '<br>';
  4667. return;
  4668. }
  4669. &WriteStringToFile("$DataDir/noedit", 'editing locked.');
  4670. print T('Wiki DB locked for conversion.') . '<br>';
  4671. print T('Converting Wiki DB...') . '<br>';
  4672. &ConvertFsFile($oldFS, $newFS, "$DataDir/rclog");
  4673. &ConvertFsFile($oldFS, $newFS, "$DataDir/rclog.old");
  4674. &ConvertFsFile($oldFS, $newFS, "$DataDir/oldrclog");
  4675. &ConvertFsFile($oldFS, $newFS, "$DataDir/oldrclog.old");
  4676. &ConvertFsDir($oldFS, $newFS, $PageDir);
  4677. &ConvertFsDir($oldFS, $newFS, $KeepDir);
  4678. &ConvertFsDir($oldFS, $newFS, $UserDir);
  4679. &ConvertFsCleanup($PageDir);
  4680. &ConvertFsCleanup($KeepDir);
  4681. &ConvertFsCleanup($UserDir);
  4682. print T('Finished converting wiki DB.') . '<br>';
  4683. print Ts('Remove file %s to unlock wiki for editing.', "$DataDir/noedit")
  4684. . '<br>';
  4685. print &GetCommonFooter();
  4686. }
  4687. # Remove user-id files if no useful preferences set
  4688. sub DoTrimUsers {
  4689. my (%Data, $status, $data, $maxID, $id, $removed, $keep);
  4690. my (@dirs, @files, $dir, $file, $item);
  4691. print &GetHeader('', T('Trim wiki users'), '');
  4692. return if (!&UserIsAdminOrError());
  4693. $removed = 0;
  4694. $maxID = 1001;
  4695. opendir(DIRLIST, $UserDir);
  4696. @dirs = readdir(DIRLIST);
  4697. closedir(DIRLIST);
  4698. foreach $dir (@dirs) {
  4699. next if (substr($dir, 0, 1) eq '.'); # No ., .., or .dirs
  4700. next if (!-d "$UserDir/$dir"); # Top level directories only
  4701. opendir(DIRLIST, "$UserDir/$dir");
  4702. @files = readdir(DIRLIST);
  4703. closedir(DIRLIST);
  4704. foreach $file (@files) {
  4705. if ($file =~ m/(\d+).db/) { # Only numeric ID files
  4706. $id = $1;
  4707. $maxID = $id if ($id > $maxID);
  4708. %Data = ();
  4709. ($status, $data) = &ReadFile("$UserDir/$dir/$file");
  4710. if ($status) {
  4711. %Data = split(/$FS1/, $data, -1); # -1 keeps trailing null fields
  4712. $keep = 0;
  4713. foreach $item (qw(username password adminpw stylesheet)) {
  4714. $keep = 1 if (defined($Data{$item}) && ($Data{$item} ne ''));
  4715. }
  4716. if (!$keep) {
  4717. unlink "$UserDir/$dir/$file";
  4718. # print "$UserDir/$dir/$file" . '<br>'; # progress
  4719. $removed += 1;
  4720. }
  4721. }
  4722. }
  4723. }
  4724. }
  4725. print Ts('Removed %s files.', $removed) . '<br>';
  4726. print Ts('Recommended $StartUID setting is %s.', $maxID + 100) . '<br>';
  4727. print &GetCommonFooter();
  4728. }
  4729. #END_OF_OTHER_CODE
  4730. &DoWikiRequest() if ($RunCGI && ($_ ne 'nocgi')); # Do everything.
  4731. 1; # In case we are loaded from elsewhere
  4732. # == End of UseModWiki script. ===========================================