usemod-1.0.4.pl 156 KB

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