123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817281828192820282128222823282428252826282728282829283028312832283328342835283628372838283928402841284228432844284528462847284828492850285128522853285428552856285728582859286028612862286328642865286628672868286928702871287228732874287528762877287828792880288128822883288428852886288728882889289028912892289328942895289628972898289929002901290229032904290529062907290829092910291129122913291429152916291729182919292029212922292329242925292629272928292929302931293229332934293529362937293829392940294129422943294429452946294729482949295029512952295329542955295629572958295929602961296229632964296529662967296829692970297129722973297429752976297729782979298029812982298329842985298629872988298929902991299229932994299529962997299829993000300130023003300430053006300730083009301030113012301330143015301630173018301930203021302230233024302530263027302830293030303130323033303430353036303730383039304030413042304330443045304630473048304930503051305230533054305530563057305830593060306130623063306430653066306730683069307030713072307330743075307630773078307930803081308230833084308530863087308830893090309130923093309430953096309730983099310031013102310331043105310631073108310931103111311231133114311531163117311831193120312131223123312431253126312731283129313031313132313331343135313631373138313931403141314231433144314531463147314831493150315131523153315431553156315731583159316031613162316331643165316631673168316931703171317231733174317531763177317831793180318131823183318431853186318731883189319031913192319331943195319631973198319932003201320232033204320532063207320832093210321132123213321432153216321732183219322032213222322332243225322632273228322932303231323232333234323532363237323832393240324132423243324432453246324732483249325032513252325332543255325632573258325932603261326232633264326532663267326832693270327132723273327432753276327732783279328032813282328332843285328632873288328932903291329232933294329532963297329832993300330133023303330433053306330733083309331033113312331333143315331633173318331933203321332233233324332533263327332833293330333133323333333433353336333733383339334033413342334333443345334633473348334933503351335233533354335533563357335833593360336133623363336433653366336733683369337033713372337333743375337633773378337933803381338233833384338533863387338833893390339133923393339433953396339733983399340034013402340334043405340634073408340934103411341234133414341534163417341834193420342134223423342434253426342734283429343034313432343334343435343634373438343934403441344234433444344534463447344834493450345134523453345434553456345734583459346034613462346334643465346634673468346934703471347234733474347534763477347834793480348134823483348434853486348734883489349034913492349334943495349634973498349935003501350235033504350535063507350835093510351135123513351435153516351735183519352035213522352335243525352635273528352935303531353235333534353535363537353835393540354135423543354435453546354735483549355035513552355335543555355635573558355935603561356235633564356535663567356835693570357135723573357435753576357735783579358035813582358335843585358635873588358935903591359235933594359535963597359835993600360136023603360436053606360736083609361036113612361336143615361636173618361936203621362236233624362536263627362836293630363136323633363436353636363736383639364036413642364336443645364636473648364936503651365236533654365536563657365836593660366136623663366436653666366736683669367036713672367336743675367636773678367936803681368236833684368536863687368836893690369136923693369436953696369736983699370037013702370337043705370637073708370937103711371237133714371537163717371837193720372137223723372437253726372737283729373037313732373337343735373637373738373937403741374237433744374537463747374837493750375137523753375437553756375737583759376037613762376337643765376637673768376937703771377237733774377537763777377837793780378137823783378437853786378737883789379037913792379337943795379637973798379938003801380238033804380538063807380838093810381138123813381438153816381738183819382038213822382338243825382638273828382938303831383238333834383538363837383838393840384138423843384438453846384738483849385038513852385338543855385638573858385938603861386238633864386538663867386838693870387138723873387438753876387738783879388038813882388338843885388638873888388938903891389238933894389538963897389838993900390139023903390439053906390739083909391039113912391339143915391639173918391939203921392239233924392539263927392839293930393139323933393439353936393739383939394039413942394339443945394639473948394939503951395239533954395539563957395839593960396139623963396439653966396739683969397039713972397339743975397639773978397939803981398239833984398539863987398839893990399139923993399439953996399739983999400040014002400340044005400640074008400940104011401240134014401540164017401840194020402140224023402440254026402740284029403040314032403340344035403640374038403940404041404240434044404540464047404840494050405140524053405440554056405740584059406040614062406340644065406640674068406940704071407240734074407540764077407840794080408140824083408440854086408740884089409040914092409340944095409640974098409941004101410241034104410541064107410841094110411141124113411441154116411741184119412041214122412341244125412641274128412941304131413241334134413541364137413841394140414141424143414441454146414741484149415041514152415341544155415641574158415941604161416241634164416541664167416841694170417141724173417441754176417741784179418041814182418341844185418641874188418941904191419241934194419541964197419841994200420142024203420442054206420742084209421042114212421342144215421642174218421942204221422242234224422542264227422842294230423142324233423442354236423742384239424042414242424342444245424642474248424942504251425242534254425542564257425842594260426142624263426442654266426742684269427042714272427342744275427642774278427942804281428242834284428542864287428842894290429142924293429442954296429742984299430043014302430343044305430643074308430943104311431243134314431543164317431843194320432143224323432443254326432743284329433043314332433343344335433643374338433943404341434243434344434543464347434843494350435143524353435443554356435743584359436043614362436343644365436643674368436943704371437243734374437543764377437843794380438143824383438443854386438743884389439043914392439343944395439643974398439944004401440244034404440544064407440844094410441144124413441444154416441744184419442044214422442344244425442644274428442944304431443244334434443544364437443844394440444144424443444444454446444744484449445044514452445344544455445644574458445944604461446244634464446544664467446844694470447144724473447444754476447744784479448044814482448344844485448644874488448944904491449244934494449544964497449844994500450145024503450445054506450745084509451045114512451345144515451645174518451945204521452245234524452545264527452845294530453145324533453445354536453745384539454045414542454345444545454645474548454945504551455245534554455545564557455845594560456145624563456445654566456745684569457045714572457345744575457645774578457945804581458245834584458545864587458845894590459145924593459445954596459745984599460046014602460346044605460646074608460946104611461246134614461546164617461846194620462146224623462446254626462746284629463046314632463346344635463646374638463946404641464246434644464546464647464846494650465146524653465446554656465746584659466046614662466346644665466646674668466946704671467246734674467546764677467846794680468146824683468446854686468746884689469046914692469346944695469646974698469947004701470247034704470547064707470847094710471147124713471447154716471747184719472047214722472347244725472647274728472947304731473247334734473547364737473847394740474147424743474447454746474747484749475047514752475347544755475647574758475947604761476247634764476547664767476847694770477147724773477447754776477747784779478047814782478347844785478647874788478947904791479247934794479547964797479847994800480148024803480448054806480748084809481048114812481348144815481648174818481948204821482248234824482548264827482848294830483148324833483448354836483748384839484048414842484348444845484648474848484948504851485248534854485548564857485848594860486148624863486448654866486748684869487048714872487348744875487648774878487948804881488248834884488548864887488848894890489148924893489448954896489748984899490049014902490349044905490649074908490949104911491249134914491549164917491849194920492149224923492449254926492749284929493049314932493349344935493649374938493949404941494249434944494549464947494849494950495149524953495449554956495749584959496049614962496349644965496649674968496949704971497249734974497549764977497849794980498149824983498449854986498749884989499049914992499349944995499649974998499950005001500250035004500550065007500850095010501150125013501450155016501750185019502050215022502350245025502650275028502950305031503250335034503550365037503850395040504150425043504450455046504750485049505050515052505350545055505650575058505950605061506250635064506550665067506850695070507150725073507450755076507750785079508050815082508350845085508650875088508950905091509250935094509550965097509850995100510151025103510451055106510751085109511051115112511351145115511651175118511951205121512251235124512551265127512851295130513151325133513451355136513751385139514051415142514351445145514651475148514951505151515251535154515551565157515851595160516151625163516451655166516751685169517051715172 |
- #!/usr/bin/perl
- # UseModWiki version 1.0.4 (December 1, 2007)
- # Copyright (C) 2000-2003 Clifford A. Adams <caadams@usemod.com>
- # Copyright (C) 2002-2003 Sunir Shah <sunir@sunir.org>
- # Based on the GPLed AtisWiki 0.3 (C) 1998 Markus Denker
- # <marcus@ira.uka.de>
- # ...which was based on
- # the LGPLed CVWiki CVS-patches (C) 1997 Peter Merel
- # and The Original WikiWikiWeb (C) Ward Cunningham
- # <ward@c2.com> (code reused with permission)
- # Email and ThinLine options by Jim Mahoney <mahoney@marlboro.edu>
- #
- # This program is free software; you can redistribute it and/or modify
- # it under the terms of the GNU General Public License as published by
- # the Free Software Foundation; either version 3 of the License, or
- # (at your option) any later version.
- #
- # This program is distributed in the hope that it will be useful,
- # but WITHOUT ANY WARRANTY; without even the implied warranty of
- # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- # GNU General Public License for more details.
- #
- # You should have received a copy of the GNU General Public License
- # along with this program. If not, see <http://www.gnu.org/licenses/>.
- package UseModWiki;
- use strict;
- local $| = 1; # Do not buffer output (localized for mod_perl)
- # Configuration/constant variables:
- use vars qw(@RcDays @HtmlPairs @HtmlSingle
- $TempDir $LockDir $DataDir $HtmlDir $UserDir $KeepDir $PageDir
- $InterFile $RcFile $RcOldFile $IndexFile $FullUrl $SiteName $HomePage
- $LogoUrl $RcDefault $IndentLimit $RecentTop $EditAllowed $UseDiff
- $UseSubpage $UseCache $RawHtml $SimpleLinks $NonEnglish $LogoLeft
- $KeepDays $HtmlTags $HtmlLinks $UseDiffLog $KeepMajor $KeepAuthor
- $FreeUpper $EmailNotify $SendMail $EmailFrom $FastGlob $EmbedWiki
- $ScriptTZ $BracketText $UseAmPm $UseConfig $UseIndex $UseLookup
- $RedirType $AdminPass $EditPass $UseHeadings $NetworkFile $BracketWiki
- $FreeLinks $WikiLinks $AdminDelete $FreeLinkPattern $RCName $RunCGI
- $ShowEdits $ThinLine $LinkPattern $InterLinkPattern $InterSitePattern
- $UrlProtocols $UrlPattern $ImageExtensions $RFCPattern $ISBNPattern
- $FS $FS1 $FS2 $FS3 $CookieName $SiteBase $StyleSheet $NotFoundPg
- $FooterNote $EditNote $MaxPost $NewText $NotifyDefault $HttpCharset
- $UserGotoBar $DeletedPage $ReplaceFile @ReplaceableFiles $TableSyntax
- $MetaKeywords $NamedAnchors $InterWikiMoniker $SiteDescription $RssLogoUrl
- $NumberDates $EarlyRules $LateRules $NewFS $KeepSize $SlashLinks $BGColor
- $UpperFirst $AdminBar $RepInterMap $DiffColor1 $DiffColor2 $ConfirmDel
- $MaskHosts $LockCrash $ConfigFile $HistoryEdit $OldThinLine
- @IsbnNames @IsbnPre @IsbnPost $EmailFile $FavIcon $RssDays $UserHeader
- $UserBody $StartUID $ParseParas $AuthorFooter $UseUpload $AllUpload
- $UploadDir $UploadUrl $LimitFileUrl $MaintTrimRc $SearchButton
- $EditNameLink $UseMetaWiki @ImageSites $BracketImg );
- # Note: $NotifyDefault is kept because it was a config variable in 0.90
- # Other global variables:
- use vars qw(%Page %Section %Text %InterSite %SaveUrl %SaveNumUrl
- %KeptRevisions %UserCookie %SetCookie %UserData %IndexHash %Translate
- %LinkIndex $InterSiteInit $SaveUrlIndex $SaveNumUrlIndex $MainPage
- $OpenPageName @KeptList @IndexList $IndexInit $TableMode
- $q $Now $UserID $TimeZoneOffset $ScriptName $BrowseCode $OtherCode
- $AnchoredLinkPattern @HeadingNumbers $TableOfContents $QuotedFullUrl
- $ConfigError $UploadPattern );
- # == Configuration =====================================================
- $DataDir = "/tmp/mywikidb"; # Main wiki directory
- $UseConfig = 1; # 1 = use config file, 0 = do not look for config
- $ConfigFile = "$DataDir/config"; # Configuration file
- # Default configuration (used if UseConfig is 0)
- $CookieName = "Wiki"; # Name for this wiki (for multi-wiki sites)
- $SiteName = "Wiki"; # Name of site (used for titles)
- $HomePage = "HomePage"; # Home page (change space to _)
- $RCName = "RecentChanges"; # Name of changes page (change space to _)
- $LogoUrl = "/wiki.gif"; # URL for site logo ("" for no logo)
- $ENV{PATH} = "/usr/bin/"; # Path used to find "diff"
- $ScriptTZ = ""; # Local time zone ("" means do not print)
- $RcDefault = 30; # Default number of RecentChanges days
- @RcDays = qw(1 3 7 30 90); # Days for links on RecentChanges
- $KeepDays = 14; # Days to keep old revisions
- $SiteBase = ""; # Full URL for <BASE> header
- $FullUrl = ""; # Set if the auto-detected URL is wrong
- $RedirType = 1; # 1 = CGI.pm, 2 = script, 3 = no redirect
- $AdminPass = ""; # Set to non-blank to enable password(s)
- $EditPass = ""; # Like AdminPass, but for editing only
- $StyleSheet = ""; # URL for CSS stylesheet (like "/wiki.css")
- $NotFoundPg = ""; # Page for not-found links ("" for blank pg)
- $EmailFrom = "Wiki"; # Text for "From: " field of email notes.
- $SendMail = "/usr/sbin/sendmail"; # Full path to sendmail executable
- $FooterNote = ""; # HTML for bottom of every page
- $EditNote = ""; # HTML notice above buttons on edit page
- $MaxPost = 1024 * 210; # Maximum 210K posts (about 200K for pages)
- $NewText = ""; # New page text ("" for default message)
- $HttpCharset = ""; # Charset for pages, like "iso-8859-2"
- $UserGotoBar = ""; # HTML added to end of goto bar
- $InterWikiMoniker = ''; # InterWiki moniker for this wiki. (for RSS)
- $SiteDescription = $SiteName; # Description of this wiki. (for RSS)
- $RssLogoUrl = ''; # Optional image for RSS feed
- $EarlyRules = ''; # Local syntax rules for wiki->html (evaled)
- $LateRules = ''; # Local syntax rules for wiki->html (evaled)
- $KeepSize = 0; # If non-zero, maximum size of keep file
- $BGColor = 'white'; # Background color ('' to disable)
- $DiffColor1 = '#ffffaf'; # Background color of old/deleted text
- $DiffColor2 = '#cfffcf'; # Background color of new/added text
- $FavIcon = ''; # URL of bookmark/favorites icon, or ''
- $RssDays = 7; # Default number of days in RSS feed
- $UserHeader = ''; # Optional HTML header additional content
- $UserBody = ''; # Optional <BODY> tag additional content
- $StartUID = 1001; # Starting number for user IDs
- $UploadDir = ''; # Full path (like /foo/www/uploads) for files
- $UploadUrl = ''; # Full URL (like http://foo.com/uploads)
- @ImageSites = qw(); # Url prefixes of good image sites: ()=all
- # Major options:
- $UseSubpage = 1; # 1 = use subpages, 0 = do not use subpages
- $UseCache = 0; # 1 = cache HTML pages, 0 = generate every page
- $EditAllowed = 1; # 1 = editing allowed, 0 = read-only
- $RawHtml = 0; # 1 = allow <HTML> tag, 0 = no raw HTML in pages
- $HtmlTags = 0; # 1 = "unsafe" HTML tags, 0 = only minimal tags
- $UseDiff = 1; # 1 = use diff features, 0 = do not use diff
- $FreeLinks = 1; # 1 = use [[word]] links, 0 = LinkPattern only
- $WikiLinks = 1; # 1 = use LinkPattern, 0 = use [[word]] only
- $AdminDelete = 1; # 1 = Admin only deletes, 0 = Editor can delete
- $RunCGI = 1; # 1 = Run script as CGI, 0 = Load but do not run
- $EmailNotify = 0; # 1 = use email notices, 0 = no email on changes
- $EmbedWiki = 0; # 1 = no headers/footers, 0 = normal wiki pages
- $DeletedPage = 'DeletedPage'; # 0 = disable, 'PageName' = tag to delete page
- $ReplaceFile = 'ReplaceFile'; # 0 = disable, 'PageName' = indicator tag
- @ReplaceableFiles = (); # List of allowed server files to replace
- $TableSyntax = 1; # 1 = wiki syntax tables, 0 = no table syntax
- $NewFS = 0; # 1 = new multibyte $FS, 0 = old $FS
- $UseUpload = 0; # 1 = allow uploads, 0 = no uploads
- # Minor options:
- $LogoLeft = 0; # 1 = logo on left, 0 = logo on right
- $RecentTop = 1; # 1 = recent on top, 0 = recent on bottom
- $UseDiffLog = 1; # 1 = save diffs to log, 0 = do not save diffs
- $KeepMajor = 1; # 1 = keep major rev, 0 = expire all revisions
- $KeepAuthor = 1; # 1 = keep author rev, 0 = expire all revisions
- $ShowEdits = 0; # 1 = show minor edits, 0 = hide edits by default
- $HtmlLinks = 0; # 1 = allow A HREF links, 0 = no raw HTML links
- $SimpleLinks = 0; # 1 = only letters, 0 = allow _ and numbers
- $NonEnglish = 0; # 1 = extra link chars, 0 = only A-Za-z chars
- $ThinLine = 0; # 1 = fancy <hr> tags, 0 = classic wiki <hr>
- $BracketText = 1; # 1 = allow [URL text], 0 = no link descriptions
- $UseAmPm = 1; # 1 = use am/pm in times, 0 = use 24-hour times
- $UseIndex = 0; # 1 = use index file, 0 = slow/reliable method
- $UseHeadings = 1; # 1 = allow = h1 text =, 0 = no header formatting
- $NetworkFile = 1; # 1 = allow remote file:, 0 = no file:// links
- $BracketWiki = 0; # 1 = [WikiLnk txt] link, 0 = no local descriptions
- $UseLookup = 1; # 1 = lookup host names, 0 = skip lookup (IP only)
- $FreeUpper = 1; # 1 = force upper case, 0 = do not force case
- $FastGlob = 1; # 1 = new faster code, 0 = old compatible code
- $MetaKeywords = 1; # 1 = Google-friendly, 0 = search-engine averse
- $NamedAnchors = 1; # 0 = no anchors, 1 = enable anchors,
- # 2 = enable but suppress display
- $SlashLinks = 0; # 1 = use script/action links, 0 = script?action
- $UpperFirst = 1; # 1 = free links start uppercase, 0 = no ucfirst
- $AdminBar = 1; # 1 = admins see admin links, 0 = no admin bar
- $RepInterMap = 0; # 1 = intermap is replacable, 0 = not replacable
- $ConfirmDel = 1; # 1 = delete link confirm page, 0 = immediate delete
- $MaskHosts = 0; # 1 = mask hosts/IPs, 0 = no masking
- $LockCrash = 0; # 1 = crash if lock stuck, 0 = auto clear locks
- $HistoryEdit = 0; # 1 = edit links on history page, 0 = no edit links
- $OldThinLine = 0; # 1 = old ==== thick line, 0 = ------ for thick line
- $NumberDates = 0; # 1 = 2003-6-17 dates, 0 = June 17, 2003 dates
- $ParseParas = 0; # 1 = new paragraph markup, 0 = old markup
- $AuthorFooter = 1; # 1 = show last author in footer, 0 = do not show
- $AllUpload = 0; # 1 = anyone can upload, 0 = only editor/admins
- $LimitFileUrl = 1; # 1 = limited use of file: URLs, 0 = no limits
- $MaintTrimRc = 0; # 1 = maintain action trims RC, 0 = only maintainrc
- $SearchButton = 0; # 1 = search button on page, 0 = old behavior
- $EditNameLink = 0; # 1 = edit links use name (CSS), 0 = '?' links
- $UseMetaWiki = 0; # 1 = add MetaWiki search links, 0 = no MW links
- $BracketImg = 1; # 1 = [url url.gif] becomes image link, 0 = no img
- # Names of sites. (The first entry is used for the number link.)
- @IsbnNames = ('bn.com', 'amazon.com', 'search');
- # Full URL of each site before the ISBN
- @IsbnPre = ('http://search.barnesandnoble.com/booksearch/isbninquiry.asp?isbn=',
- 'http://www.amazon.com/exec/obidos/ISBN=',
- 'http://www.pricescan.com/books/BookDetail.asp?isbn=');
- # Rest of URL of each site after the ISBN (usually '')
- @IsbnPost = ('', '', '');
- # HTML tag lists, enabled if $HtmlTags is set.
- # Scripting is currently possible with these tags,
- # so they are *not* particularly "safe".
- # Tags that must be in <tag> ... </tag> pairs:
- @HtmlPairs = qw(b i u font big small sub sup h1 h2 h3 h4 h5 h6 cite code
- em s strike strong tt var div center blockquote ol ul dl table caption);
- # Single tags (that do not require a closing /tag)
- @HtmlSingle = qw(br p hr li dt dd tr td th);
- @HtmlPairs = (@HtmlPairs, @HtmlSingle); # All singles can also be pairs
- # == You should not have to change anything below this line. =============
- $IndentLimit = 20; # Maximum depth of nested lists
- $PageDir = "$DataDir/page"; # Stores page data
- $HtmlDir = "$DataDir/html"; # Stores HTML versions
- $UserDir = "$DataDir/user"; # Stores user data
- $KeepDir = "$DataDir/keep"; # Stores kept (old) page data
- $TempDir = "$DataDir/temp"; # Temporary files and locks
- $LockDir = "$TempDir/lock"; # DB is locked if this exists
- $InterFile = "$DataDir/intermap"; # Interwiki site->url map
- $RcFile = "$DataDir/rclog"; # New RecentChanges logfile
- $RcOldFile = "$DataDir/oldrclog"; # Old RecentChanges logfile
- $IndexFile = "$DataDir/pageidx"; # List of all pages
- $EmailFile = "$DataDir/emails"; # Email notification lists
- if ($RepInterMap) {
- push @ReplaceableFiles, $InterFile;
- }
- # The "main" program, called at the end of this script file.
- sub DoWikiRequest {
- if ($UseConfig && (-f $ConfigFile)) {
- $ConfigError = '';
- if (!do $ConfigFile) { # Some error occurred
- $ConfigError = $@;
- if ($ConfigError eq '') {
- # Unfortunately, if the last expr returns 0, one will get a false
- # error above. To remain compatible with existing installs the
- # wiki must not report an error unless there is error text in $@.
- # (Errors in "use strict" may not have error text.)
- # Uncomment the line below if you want to catch use strict errors.
- # $ConfigError = T('Unknown Error (no error text)');
- }
- }
- }
- &InitLinkPatterns();
- if (!&DoCacheBrowse()) {
- eval $BrowseCode;
- &InitRequest() or return;
- if (!&DoBrowseRequest()) {
- eval $OtherCode;
- &DoOtherRequest();
- }
- }
- }
- # == Common and cache-browsing code ====================================
- sub InitLinkPatterns {
- my ($UpperLetter, $LowerLetter, $AnyLetter, $LpA, $LpB, $QDelim);
- # Field separators are used in the URL-style patterns below.
- if ($NewFS) {
- $FS = "\x1e\xff\xfe\x1e"; # An unlikely sequence for any charset
- } else {
- $FS = "\xb3"; # The FS character is a superscript "3"
- }
- $FS1 = $FS . "1"; # The FS values are used to separate fields
- $FS2 = $FS . "2"; # in stored hashtables and other data structures.
- $FS3 = $FS . "3"; # The FS character is not allowed in user data.
- $UpperLetter = "[A-Z";
- $LowerLetter = "[a-z";
- $AnyLetter = "[A-Za-z";
- if ($NonEnglish) {
- $UpperLetter .= "\xc0-\xde";
- $LowerLetter .= "\xdf-\xff";
- if ($NewFS) {
- $AnyLetter .= "\x80-\xff";
- } else {
- $AnyLetter .= "\xc0-\xff";
- }
- }
- if (!$SimpleLinks) {
- $AnyLetter .= "_0-9";
- }
- $UpperLetter .= "]"; $LowerLetter .= "]"; $AnyLetter .= "]";
- # Main link pattern: lowercase between uppercase, then anything
- $LpA = $UpperLetter . "+" . $LowerLetter . "+" . $UpperLetter
- . $AnyLetter . "*";
- # Optional subpage link pattern: uppercase, lowercase, then anything
- $LpB = $UpperLetter . "+" . $LowerLetter . "+" . $AnyLetter . "*";
- if ($UseSubpage) {
- # Loose pattern: If subpage is used, subpage may be simple name
- $LinkPattern = "((?:(?:$LpA)?\\/$LpB)|$LpA)";
- # Strict pattern: both sides must be the main LinkPattern
- # $LinkPattern = "((?:(?:$LpA)?\\/)?$LpA)";
- } else {
- $LinkPattern = "($LpA)";
- }
- $QDelim = '(?:"")?'; # Optional quote delimiter (not in output)
- $AnchoredLinkPattern = $LinkPattern . '#(\\w+)' . $QDelim if $NamedAnchors;
- $LinkPattern .= $QDelim;
- # Inter-site convention: sites must start with uppercase letter
- # (Uppercase letter avoids confusion with URLs)
- $InterSitePattern = $UpperLetter . $AnyLetter . "+";
- $InterLinkPattern = "((?:$InterSitePattern:[^\\]\\s\"<>$FS]+)$QDelim)";
- if ($FreeLinks) {
- # Note: the - character must be first in $AnyLetter definition
- if ($NonEnglish) {
- if ($NewFS) {
- $AnyLetter = "[-,.()' _0-9A-Za-z\x80-\xff]";
- } else {
- $AnyLetter = "[-,.()' _0-9A-Za-z\xc0-\xff]";
- }
- } else {
- $AnyLetter = "[-,.()' _0-9A-Za-z]";
- }
- }
- $FreeLinkPattern = "($AnyLetter+)";
- if ($UseSubpage) {
- $FreeLinkPattern = "((?:(?:$AnyLetter+)?\\/)?$AnyLetter+)";
- }
- $FreeLinkPattern .= $QDelim;
- # Url-style links are delimited by one of:
- # 1. Whitespace (kept in output)
- # 2. Left or right angle-bracket (< or >) (kept in output)
- # 3. Right square-bracket (]) (kept in output)
- # 4. A single double-quote (") (kept in output)
- # 5. A $FS (field separator) character (kept in output)
- # 6. A double double-quote ("") (removed from output)
- $UrlProtocols = "http|https|ftp|afs|news|nntp|mid|cid|mailto|wais|"
- . "prospero|telnet|gopher";
- $UrlProtocols .= '|file' if ($NetworkFile || !$LimitFileUrl);
- $UrlPattern = "((?:(?:$UrlProtocols):[^\\]\\s\"<>$FS]+)$QDelim)";
- $ImageExtensions = "(gif|jpg|png|bmp|jpeg|ico|tiff?)";
- $RFCPattern = "RFC\\s?(\\d+)";
- $ISBNPattern = "ISBN:?([0-9- xX]{10,})";
- $UploadPattern = "upload:([^\\]\\s\"<>$FS]+)$QDelim";
- }
- # Simple HTML cache
- sub DoCacheBrowse {
- my ($query, $idFile, $text);
- return 0 if (!$UseCache);
- $query = $ENV{'QUERY_STRING'};
- if (($query eq "") && ($ENV{'REQUEST_METHOD'} eq "GET")) {
- $query = $HomePage; # Allow caching of home page.
- }
- if (!($query =~ /^$LinkPattern$/)) {
- if (!($FreeLinks && ($query =~ /^$FreeLinkPattern$/))) {
- return 0; # Only use cache for simple links
- }
- }
- $idFile = &GetHtmlCacheFile($query);
- if (-f $idFile) {
- local $/ = undef; # Read complete files
- open(INFILE, "<$idFile") or return 0;
- $text = <INFILE>;
- close INFILE;
- print $text;
- return 1;
- }
- return 0;
- }
- sub GetHtmlCacheFile {
- my ($id) = @_;
- return $HtmlDir . "/" . &GetPageDirectory($id) . "/$id.htm";
- }
- sub GetPageDirectory {
- my ($id) = @_;
- if ($id =~ /^([a-zA-Z])/) {
- return uc($1);
- }
- return "other";
- }
- sub T {
- my ($text) = @_;
- if (defined($Translate{$text}) && ($Translate{$text} ne '')) {
- return $Translate{$text};
- }
- return $text;
- }
- sub Ts {
- my ($text, $string, $noquote) = @_;
- $string = &QuoteHtml($string) unless $noquote;
- $text = T($text);
- $text =~ s/\%s/$string/;
- return $text;
- }
- sub Tss {
- my $text = $_[0];
- my @args = @_;
- @args = map {
- $_ = &QuoteHtml($_);
- } @args;
- $text = T($text);
- $text =~ s/\%([1-9])/$args[$1]/ge;
- return $text;
- }
- sub QuoteHtml {
- my ($html) = @_;
- $html =~ s/&/&/g;
- $html =~ s/</</g;
- $html =~ s/>/>/g;
- $html =~ s/&([#a-zA-Z0-9]+);/&$1;/g; # Allow character references
- return $html;
- }
- # == Normal page-browsing and RecentChanges code =======================
- $BrowseCode = ""; # Comment next line to always compile (slower)
- #$BrowseCode = <<'#END_OF_BROWSE_CODE';
- use CGI;
- use CGI::Carp qw(fatalsToBrowser);
- sub InitRequest {
- my @ScriptPath = split('/', "$ENV{SCRIPT_NAME}");
- $CGI::POST_MAX = $MaxPost;
- if ($UseUpload) {
- $CGI::DISABLE_UPLOADS = 0; # allow uploads
- } else {
- $CGI::DISABLE_UPLOADS = 1; # no uploads
- }
- $q = new CGI;
- # Fix some issues with editing UTF8 pages (if charset specified)
- if ($HttpCharset ne '') {
- $q->charset($HttpCharset);
- }
- $Now = time; # Reset in case script is persistent
- $ScriptName = pop(@ScriptPath); # Name used in links
- $IndexInit = 0; # Must be reset for each request
- $InterSiteInit = 0;
- %InterSite = ();
- $MainPage = "."; # For subpages only, the name of the top-level page
- $OpenPageName = ""; # Currently open page
- &CreateDir($DataDir); # Create directory if it doesn't exist
- if (!-d $DataDir) {
- &ReportError(Ts('Could not create %s', $DataDir) . ": $!");
- return 0;
- }
- &InitCookie(); # Reads in user data
- return 1;
- }
- sub InitCookie {
- %SetCookie = ();
- $TimeZoneOffset = 0;
- undef $q->{'.cookies'}; # Clear cache if it exists (for SpeedyCGI)
- %UserData = (); # Fix for persistent environments.
- %UserCookie = $q->cookie($CookieName);
- $UserID = $UserCookie{'id'};
- $UserID =~ s/\D//g; # Numeric only
- if ($UserID < 200) {
- $UserID = 111;
- } else {
- &LoadUserData($UserID);
- }
- if ($UserID > 199) {
- if (($UserData{'id'} != $UserCookie{'id'}) ||
- ($UserData{'randkey'} != $UserCookie{'randkey'})) {
- $UserID = 113;
- %UserData = (); # Invalid. Consider warning message.
- }
- }
- if ($UserData{'tzoffset'} != 0) {
- $TimeZoneOffset = $UserData{'tzoffset'} * (60 * 60);
- }
- }
- sub DoBrowseRequest {
- my ($id, $action, $text);
- if (!$q->param) { # No parameter
- &BrowsePage($HomePage);
- return 1;
- }
- $id = &GetParam('keywords', '');
- if ($id) { # Just script?PageName
- if ($FreeLinks && (!-f &GetPageFile($id))) {
- $id = &FreeToNormal($id);
- }
- if (($NotFoundPg ne '') && (!-f &GetPageFile($id))) {
- $id = $NotFoundPg;
- }
- &BrowsePage($id) if &ValidIdOrDie($id);
- return 1;
- }
- $action = lc(&GetParam('action', ''));
- $id = &GetParam('id', '');
- if ($action eq 'browse') {
- if ($FreeLinks && (!-f &GetPageFile($id))) {
- $id = &FreeToNormal($id);
- }
- if (($NotFoundPg ne '') && (!-f &GetPageFile($id))) {
- $id = $NotFoundPg;
- }
- &BrowsePage($id) if &ValidIdOrDie($id);
- return 1;
- } elsif ($action eq 'rc') {
- &BrowsePage($RCName);
- return 1;
- } elsif ($action eq 'random') {
- &DoRandom();
- return 1;
- } elsif ($action eq 'history') {
- &DoHistory($id) if &ValidIdOrDie($id);
- return 1;
- }
- return 0; # Request not handled
- }
- sub BrowsePage {
- my ($id) = @_;
- my ($fullHtml, $oldId, $allDiff, $showDiff, $openKept);
- my ($revision, $goodRevision, $diffRevision, $newText);
- &OpenPage($id);
- &OpenDefaultText();
- $openKept = 0;
- $revision = &GetParam('revision', '');
- $revision =~ s/\D//g; # Remove non-numeric chars
- $goodRevision = $revision; # Non-blank only if exists
- if ($revision ne '') {
- &OpenKeptRevisions('text_default');
- $openKept = 1;
- if (!defined($KeptRevisions{$revision})) {
- $goodRevision = '';
- } else {
- &OpenKeptRevision($revision);
- }
- }
- # Raw mode: just untranslated wiki text
- if (&GetParam('raw', 0)) {
- print &GetHttpHeader('text/plain');
- print $Text{'text'};
- return;
- }
- $newText = $Text{'text'}; # For differences
- # Handle a single-level redirect
- $oldId = &GetParam('oldid', '');
- if (($oldId eq '') && (substr($Text{'text'}, 0, 10) eq '#REDIRECT ')) {
- $oldId = $id;
- if (($FreeLinks) && ($Text{'text'} =~ /\#REDIRECT\s+\[\[.+\]\]/)) {
- ($id) = ($Text{'text'} =~ /\#REDIRECT\s+\[\[(.+)\]\]/);
- $id = &FreeToNormal($id);
- } else {
- ($id) = ($Text{'text'} =~ /\#REDIRECT\s+(\S+)/);
- }
- if (&ValidId($id) eq '') {
- # Consider revision in rebrowse?
- &ReBrowsePage($id, $oldId, 0);
- return;
- } else { # Not a valid target, so continue as normal page
- $id = $oldId;
- $oldId = '';
- }
- }
- $MainPage = $id;
- $MainPage =~ s|/.*||; # Only the main page name (remove subpage)
- $fullHtml = &GetHeader($id, &QuoteHtml($id), $oldId, 1);
- if ($revision ne '') {
- if (($revision eq $Page{'revision'}) || ($goodRevision ne '')) {
- $fullHtml .= '<b>' . Ts('Showing revision %s', $revision) . "</b><br>";
- } else {
- $fullHtml .= '<b>' . Ts('Revision %s not available', $revision)
- . ' (' . T('showing current revision instead')
- . ')</b><br>';
- }
- }
- $allDiff = &GetParam('alldiff', 0);
- if ($allDiff != 0) {
- $allDiff = &GetParam('defaultdiff', 1);
- }
- if ((($id eq $RCName) || (T($RCName) eq $id) || (T($id) eq $RCName))
- && &GetParam('norcdiff', 1)) {
- $allDiff = 0; # Only show if specifically requested
- }
- $showDiff = &GetParam('diff', $allDiff);
- if ($UseDiff && $showDiff) {
- $diffRevision = $goodRevision;
- $diffRevision = &GetParam('diffrevision', $diffRevision);
- # Eventually try to avoid the following keep-loading if possible?
- &OpenKeptRevisions('text_default') if (!$openKept);
- $fullHtml .= &GetDiffHTML($showDiff, $id, $diffRevision,
- $revision, $newText);
- $fullHtml .= "<hr class=wikilinediff>\n";
- }
- $fullHtml .= '<div class=wikitext>';
- $fullHtml .= &WikiToHTML($Text{'text'});
- $fullHtml .= '</div>';
- if (($id eq $RCName) || (T($RCName) eq $id) || (T($id) eq $RCName)) {
- print $fullHtml;
- print "<hr class=wikilinerc>\n";
- print '<div class=wikirc>';
- &DoRc(1);
- print '</div>';
- print &GetFooterText($id, $goodRevision);
- return;
- }
- $fullHtml .= &GetFooterText($id, $goodRevision);
- print $fullHtml;
- return if ($showDiff || ($revision ne '')); # Don't cache special version
- &UpdateHtmlCache($id, $fullHtml) if ($UseCache && ($oldId eq ''));
- }
- sub ReBrowsePage {
- my ($id, $oldId, $isEdit) = @_;
- if ($oldId ne "") { # Target of #REDIRECT (loop breaking)
- print &GetRedirectPage("action=browse&id=$id&oldid=$oldId",
- $id, $isEdit);
- } else {
- print &GetRedirectPage($id, $id, $isEdit);
- }
- }
- sub DoRc {
- my ($rcType) = @_; # 0 = RSS, 1 = HTML
- my ($fileData, $rcline, $i, $daysago, $lastTs, $ts, $idOnly);
- my (@fullrc, $status, $oldFileData, $firstTs, $errorText, $showHTML);
- my $starttime = 0;
- my $showbar = 0;
- if (0 == $rcType) {
- $showHTML = 0;
- } else {
- $showHTML = 1;
- }
- if (&GetParam("from", 0)) {
- $starttime = &GetParam("from", 0);
- if ($showHTML) {
- print "<h2>" . Ts('Updates since %s', &TimeToText($starttime))
- . "</h2>\n";
- }
- } else {
- $daysago = &GetParam("days", 0);
- $daysago = &GetParam("rcdays", 0) if ($daysago == 0);
- if ($daysago) {
- $starttime = $Now - ((24*60*60)*$daysago);
- if ($showHTML) {
- print "<h2>" . Ts('Updates in the last %s day'
- . (($daysago != 1)?"s":""), $daysago) . "</h2>\n";
- }
- # Note: must have two translations (for "day" and "days")
- # Following comment line is for translation helper script
- # Ts('Updates in the last %s days', '');
- }
- }
- if ($starttime == 0) {
- if (0 == $rcType) {
- $starttime = $Now - ((24*60*60)*$RssDays);
- } else {
- $starttime = $Now - ((24*60*60)*$RcDefault);
- }
- if ($showHTML) {
- print "<h2>" . Ts('Updates in the last %s day'
- . (($RcDefault != 1)?"s":""), $RcDefault) . "</h2>\n";
- }
- # Translation of above line is identical to previous version
- }
- # Read rclog data (and oldrclog data if needed)
- ($status, $fileData) = &ReadFile($RcFile);
- $errorText = "";
- if (!$status) {
- # Save error text if needed.
- $errorText = '<p><strong>' . Ts('Could not open %s log file', $RCName)
- . ":</strong> $RcFile<p>"
- . T('Error was') . ":\n<pre>$!</pre>\n" . '<p>'
- . T('Note: This error is normal if no changes have been made.') . "\n";
- }
- @fullrc = split(/\n/, $fileData);
- $firstTs = 0;
- if (@fullrc > 0) { # Only false if no lines in file
- ($firstTs) = split(/$FS3/, $fullrc[0]);
- }
- if (($firstTs == 0) || ($starttime <= $firstTs)) {
- ($status, $oldFileData) = &ReadFile($RcOldFile);
- if ($status) {
- @fullrc = split(/\n/, $oldFileData . $fileData);
- } else {
- if ($errorText ne "") { # could not open either rclog file
- print $errorText;
- print "<p><strong>"
- . Ts('Could not open old %s log file', $RCName)
- . ":</strong> $RcOldFile<p>"
- . T('Error was') . ":\n<pre>$!</pre>\n";
- return;
- }
- }
- }
- $lastTs = 0;
- if (@fullrc > 0) { # Only false if no lines in file
- ($lastTs) = split(/$FS3/, $fullrc[$#fullrc]);
- }
- $lastTs++ if (($Now - $lastTs) > 5); # Skip last unless very recent
- $idOnly = &GetParam("rcidonly", "");
- if ($idOnly && $showHTML) {
- print '<b>(' . Ts('for %s only', &ScriptLink($idOnly, &QuoteHtml($idOnly)), 1)
- . ')</b><br>';
- }
- if ($showHTML) {
- foreach $i (@RcDays) {
- print " | " if $showbar;
- $showbar = 1;
- print &ScriptLink("action=rc&days=$i",
- Ts('%s day' . (($i != 1)?'s':''), $i));
- # Note: must have two translations (for "day" and "days")
- # Following comment line is for translation helper script
- # Ts('%s days', '');
- }
- print "<br>" . &ScriptLink("action=rc&from=$lastTs",
- T('List new changes starting from'));
- print " " . &TimeToText($lastTs) . "<br>\n";
- }
- $i = 0;
- while ($i < @fullrc) { # Optimization: skip old entries quickly
- ($ts) = split(/$FS3/, $fullrc[$i]);
- if ($ts >= $starttime) {
- $i -= 1000 if ($i > 0);
- last;
- }
- $i += 1000;
- }
- $i -= 1000 if (($i > 0) && ($i >= @fullrc));
- for (; $i < @fullrc ; $i++) {
- ($ts) = split(/$FS3/, $fullrc[$i]);
- last if ($ts >= $starttime);
- }
- if ($i == @fullrc && $showHTML) {
- print '<br><strong>' . Ts('No updates since %s',
- &TimeToText($starttime)) . "</strong><br>\n";
- } else {
- splice(@fullrc, 0, $i); # Remove items before index $i
- # Consider an end-time limit (items older than X)
- if (0 == $rcType) {
- print &GetRcRss(@fullrc);
- } else {
- print &GetRcHtml(@fullrc);
- }
- }
- if ($showHTML) {
- print '<p>' . Ts('Page generated %s', &TimeToText($Now)), "<br>\n";
- }
- }
- sub GetRc {
- my $rcType = shift;
- my @outrc = @_;
- my ($rcline, $date, $newtop, $author, $inlist, $result);
- my ($showedit, $link, $all, $idOnly, $headItem, $item);
- my ($ts, $pagename, $summary, $isEdit, $host, $kind, $extraTemp);
- my ($rcchangehist, $tEdit, $tChanges, $tDiff);
- my ($headList, $pagePrefix, $historyPrefix, $diffPrefix);
- my %extra = ();
- my %changetime = ();
- my %pagecount = ();
- # Slice minor edits
- $showedit = &GetParam("rcshowedit", $ShowEdits);
- $showedit = &GetParam("showedit", $showedit);
- if ($showedit != 1) {
- my @temprc = ();
- foreach $rcline (@outrc) {
- ($ts, $pagename, $summary, $isEdit, $host) = split(/$FS3/, $rcline);
- if ($showedit == 0) { # 0 = No edits
- push(@temprc, $rcline) if (!$isEdit);
- } else { # 2 = Only edits
- push(@temprc, $rcline) if ($isEdit);
- }
- }
- @outrc = @temprc;
- }
- # Optimize param fetches out of main loop
- $rcchangehist = &GetParam("rcchangehist", 1);
- # Optimize translations out of main loop
- $tEdit = T('(edit)');
- $tDiff = T('(diff)');
- $tChanges = T('changes');
- $pagePrefix = $QuotedFullUrl . &ScriptLinkChar();
- $diffPrefix = $pagePrefix . &QuoteHtml("action=browse&diff=4&id=");
- $historyPrefix = $pagePrefix . &QuoteHtml("action=history&id=");
- foreach $rcline (@outrc) {
- ($ts, $pagename) = split(/$FS3/, $rcline);
- $pagecount{$pagename}++;
- $changetime{$pagename} = $ts;
- }
- $date = "";
- $all = &GetParam("rcall", 0);
- $all = &GetParam("all", $all);
- $newtop = &GetParam("rcnewtop", $RecentTop);
- $newtop = &GetParam("newtop", $newtop);
- $idOnly = &GetParam("rcidonly", "");
- $inlist = 0;
- $headList = '';
- $result = '';
- @outrc = reverse @outrc if ($newtop);
- foreach $rcline (@outrc) {
- ($ts, $pagename, $summary, $isEdit, $host, $kind, $extraTemp)
- = split(/$FS3/, $rcline);
- next if ((!$all) && ($ts < $changetime{$pagename}));
- next if (($idOnly ne "") && ($idOnly ne $pagename));
- %extra = split(/$FS2/, $extraTemp, -1);
- if ($date ne &CalcDay($ts)) {
- $date = &CalcDay($ts);
- if (1 == $rcType) { # HTML
- # add date, properly closing lists first
- if ($inlist) {
- $result .= "</UL>\n";
- $inlist = 0;
- }
- $result .= "<p><strong>" . $date . "</strong></p>\n";
- if (!$inlist) {
- $result .= "<UL>\n";
- $inlist = 1;
- }
- }
- }
- if (0 == $rcType) { # RSS
- ($headItem, $item) = &GetRssRcLine($pagename, $ts, $host,
- $extra{'name'}, $extra{'id'}, $summary, $isEdit,
- $pagecount{$pagename}, $extra{'revision'},
- $diffPrefix, $historyPrefix, $pagePrefix);
- $headList .= $headItem;
- $result .= $item;
- } else { # HTML
- $result .= &GetHtmlRcLine($pagename, $ts, $host, $extra{'name'},
- $extra{'id'}, $summary, $isEdit,
- $pagecount{$pagename}, $extra{'revision'},
- $tEdit, $tDiff, $tChanges, $all, $rcchangehist);
- }
- }
- if (1 == $rcType) {
- $result .= "</UL>\n" if ($inlist); # Close final tag
- }
- return ($headList, $result); # Just ignore headList for HTML
- }
- sub GetRcHtml {
- my ($html, $extra);
- ($extra, $html) = &GetRc(1, @_);
- return $html;
- }
- sub GetHtmlRcLine {
- my ($pagename, $timestamp, $host, $userName, $userID, $summary,
- $isEdit, $pagecount, $revision, $tEdit, $tDiff, $tChanges, $all,
- $rcchangehist) = @_;
- my ($author, $sum, $edit, $count, $link, $html);
- $html = '';
- $host = &QuoteHtml($host);
- if (defined($userName) && defined($userID)) {
- $author = &GetAuthorLink($host, $userName, $userID);
- } else {
- $author = &GetAuthorLink($host, "", 0);
- }
- $sum = "";
- if (($summary ne "") && ($summary ne "*")) {
- $summary = &QuoteHtml($summary);
- $sum = "<strong>[$summary]</strong> ";
- }
- $edit = "";
- $edit = "<em>$tEdit</em> " if ($isEdit);
- $count = "";
- if ((!$all) && ($pagecount > 1)) {
- $count = "($pagecount ";
- if ($rcchangehist) {
- $count .= &GetHistoryLink($pagename, $tChanges);
- } else {
- $count .= $tChanges;
- }
- $count .= ") ";
- }
- $link = "";
- if ($UseDiff && &GetParam("diffrclink", 1)) {
- $link .= &ScriptLinkDiff(4, $pagename, $tDiff, "") . " ";
- }
- $link .= &GetPageLink($pagename);
- $html .= "<li>$link ";
- $html .= &CalcTime($timestamp) . " $count$edit" . " $sum";
- $html .= ". . . . . $author\n";
- return $html;
- }
- sub GetRcRss {
- my ($rssHeader, $headList, $items);
- # Normally get URL from script, but allow override
- $FullUrl = $q->url(-full=>1) if ($FullUrl eq "");
- $QuotedFullUrl = &QuoteHtml($FullUrl);
- $SiteDescription = &QuoteHtml($SiteDescription);
- my $ChannelAbout = &QuoteHtml($FullUrl . &ScriptLinkChar()
- . $ENV{QUERY_STRING});
- $rssHeader = <<RSS ;
- <?xml version="1.0" encoding="ISO-8859-1"?>
- <rdf:RDF
- xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#"
- xmlns="http://purl.org/rss/1.0/"
- xmlns:dc="http://purl.org/dc/elements/1.1/"
- xmlns:wiki="http://purl.org/rss/1.0/modules/wiki/"
- >
- <channel rdf:about="$ChannelAbout">
- <title>${\(&QuoteHtml($SiteName))}</title>
- <link>${\($QuotedFullUrl . &ScriptLinkChar() . &QuoteHtml("$RCName"))}</link>
- <description>${\(&QuoteHtml($SiteDescription))}</description>
- <wiki:interwiki>
- <rdf:Description link="$QuotedFullUrl">
- <rdf:value>$InterWikiMoniker</rdf:value>
- </rdf:Description>
- </wiki:interwiki>
- <items>
- <rdf:Seq>
- RSS
- ($headList, $items) = &GetRc(0, @_);
- $rssHeader .= $headList;
- return <<RSS ;
- $rssHeader
- </rdf:Seq>
- </items>
- </channel>
- <image rdf:about="${\(&QuoteHtml($RssLogoUrl))}">
- <title>${\(&QuoteHtml($SiteName))}</title>
- <url>$RssLogoUrl</url>
- <link>$QuotedFullUrl</link>
- </image>
- $items
- </rdf:RDF>
- RSS
- }
- sub GetRssRcLine{
- my ($pagename, $timestamp, $host, $userName, $userID, $summary, $isEdit,
- $pagecount, $revision, $diffPrefix, $historyPrefix, $pagePrefix) = @_;
- my ($pagenameEsc, $itemID, $description, $authorLink, $author, $status,
- $importance, $date, $item, $headItem);
- $pagenameEsc = CGI::escape($pagename);
- # Add to list of items in the <channel/>
- $itemID = $FullUrl . &ScriptLinkChar()
- . &GetOldPageParameters('browse', $pagenameEsc, $revision);
- $itemID = &QuoteHtml($itemID);
- $headItem = " <rdf:li rdf:resource=\"$itemID\"/>\n";
- # Add to list of items proper.
- if (($summary ne "") && ($summary ne "*")) {
- $description = &QuoteHtml($summary);
- }
- $host = &QuoteHtml($host);
- if ($userName) {
- $author = &QuoteHtml($userName);
- $authorLink = 'link="' . $QuotedFullUrl . &ScriptLinkChar() . $author . '"';
- } else {
- $author = $host;
- }
- $status = (1 == $revision) ? 'new' : 'updated';
- $importance = $isEdit ? 'minor' : 'major';
- $timestamp += $TimeZoneOffset;
- my ($sec, $min, $hour, $mday, $mon, $year) = localtime($timestamp);
- $year += 1900;
- $date = sprintf("%4d-%02d-%02dT%02d:%02d:%02d+%02d:00",
- $year, $mon+1, $mday, $hour, $min, $sec, $TimeZoneOffset/(60*60));
- $pagename = &QuoteHtml($pagename);
- # Write it out longhand
- $item = <<RSS ;
- <item rdf:about="$itemID">
- <title>$pagename</title>
- <link>$pagePrefix$pagenameEsc</link>
- <description>$description</description>
- <dc:date>$date</dc:date>
- <dc:contributor>
- <rdf:Description wiki:host="$host" $authorLink>
- <rdf:value>$author</rdf:value>
- </rdf:Description>
- </dc:contributor>
- <wiki:status>$status</wiki:status>
- <wiki:importance>$importance</wiki:importance>
- <wiki:diff>$diffPrefix$pagenameEsc</wiki:diff>
- <wiki:version>$revision</wiki:version>
- <wiki:history>$historyPrefix$pagenameEsc</wiki:history>
- </item>
- RSS
- return ($headItem, $item);
- }
- sub DoRss {
- print "Content-type: text/xml\n\n";
- &DoRc(0);
- }
- sub DoRandom {
- my ($id, @pageList);
- @pageList = &AllPagesList(); # Optimize?
- $id = $pageList[int(rand($#pageList + 1))];
- &ReBrowsePage($id, "", 0);
- }
- sub DoHistory {
- my ($id) = @_;
- my ($html, $canEdit, $row, $newText);
- print &GetHeader('', Ts('History of %s', $id), '') . '<br>';
- &OpenPage($id);
- &OpenDefaultText();
- $newText = $Text{'text'};
- $canEdit = 0;
- $canEdit = &UserCanEdit($id) if ($HistoryEdit);
- if ($UseDiff) {
- print <<EOF ;
- <form action="$ScriptName" METHOD="GET">
- <input type="hidden" name="action" value="browse"/>
- <input type="hidden" name="diff" value="1"/>
- <input type="hidden" name="id" value="$id"/>
- <table border="0" width="100%"><tr>
- EOF
- }
- $html = &GetHistoryLine($id, $Page{'text_default'}, $canEdit, $row++);
- &OpenKeptRevisions('text_default');
- foreach (reverse sort {$a <=> $b} keys %KeptRevisions) {
- next if ($_ eq ""); # (needed?)
- $html .= &GetHistoryLine($id, $KeptRevisions{$_}, $canEdit, $row++);
- }
- print $html;
- if ($UseDiff) {
- my $label = T('Compare');
- print "<tr><td align='center'><input type='submit' "
- . "value='$label'/> </td></table></form>\n";
- print "<hr class=wikilinediff>\n";
- print &GetDiffHTML(&GetParam('defaultdiff', 1), $id, '', '', $newText);
- }
- print &GetCommonFooter();
- }
- sub GetMaskedHost {
- my ($text) = @_;
- my ($logText);
- if (!$MaskHosts) {
- return $text;
- }
- $logText = T('(logged)');
- if (!($text =~ s/\d+$/$logText/)) { # IP address (ending numbers masked)
- $text =~ s/^[^\.\(]+/$logText/; # Host name: mask until first .
- }
- return $text;
- }
- sub GetHistoryLine {
- my ($id, $section, $canEdit, $row) = @_;
- my ($html, $expirets, $rev, $summary, $host, $user, $uid, $ts, $minor);
- my (%sect, %revtext);
- %sect = split(/$FS2/, $section, -1);
- %revtext = split(/$FS3/, $sect{'data'});
- $rev = $sect{'revision'};
- $summary = $revtext{'summary'};
- if ((defined($sect{'host'})) && ($sect{'host'} ne '')) {
- $host = $sect{'host'};
- } else {
- $host = $sect{'ip'};
- }
- $host = &GetMaskedHost($host);
- $user = $sect{'username'};
- $uid = $sect{'id'};
- $ts = $sect{'ts'};
- $minor = '';
- $minor = '<i>' . T('(edit)') . '</i> ' if ($revtext{'minor'});
- $expirets = $Now - ($KeepDays * 24 * 60 * 60);
- if ($UseDiff) {
- my ($c1, $c2);
- $c1 = 'checked="checked"' if 1 == $row;
- $c2 = 'checked="checked"' if 0 == $row;
- $html .= "<tr><td align='center'><input type='radio' "
- . "name='diffrevision' value='$rev' $c1/> ";
- $html .= "<input type='radio' name='revision' value='$rev' $c2/></td><td>";
- }
- if (0 == $row) { # current revision
- $html .= &GetPageLinkText($id, Ts('Revision %s', $rev)) . ' ';
- if ($canEdit) {
- $html .= &GetEditLink($id, T('Edit')) . ' ';
- }
- } else {
- $html .= &GetOldPageLink('browse', $id, $rev,
- Ts('Revision %s', $rev)) . ' ';
- if ($canEdit) {
- $html .= &GetOldPageLink('edit', $id, $rev, T('Edit')) . ' ';
- }
- }
- $html .= ". . " . $minor . &TimeToText($ts) . " ";
- $html .= T('by') . ' ' . &GetAuthorLink($host, $user, $uid) . " ";
- if (defined($summary) && ($summary ne "") && ($summary ne "*")) {
- $summary = &QuoteHtml($summary); # Thanks Sunir! :-)
- $html .= "<b>[$summary]</b> ";
- }
- $html .= $UseDiff ? "</tr>\n" : "<br>\n";
- return $html;
- }
- # ==== HTML and page-oriented functions ====
- sub ScriptLinkChar {
- if ($SlashLinks) {
- return '/';
- }
- return '?';
- }
- sub ScriptLink {
- my ($action, $text) = @_;
- return '<a href="' . $ScriptName . &ScriptLinkChar() . &UriEscape($action)
- . "\">$text</a>";
- }
- sub ScriptLinkClass {
- my ($action, $text, $class) = @_;
- return '<a href="' . $ScriptName . &ScriptLinkChar() . &UriEscape($action)
- . '" class="' . $class . "\">$text</a>";
- }
- sub GetPageLinkText {
- my ($id, $name) = @_;
- $id =~ s|^/|$MainPage/|;
- if ($FreeLinks) {
- $id = &FreeToNormal($id);
- $name =~ s/_/ /g;
- }
- return &ScriptLinkClass($id, $name, 'wikipagelink');
- }
- sub GetPageLink {
- my ($id) = @_;
- return &GetPageLinkText($id, $id);
- }
- sub GetEditLink {
- my ($id, $name) = @_;
- if ($FreeLinks) {
- $id = &FreeToNormal($id);
- $name =~ s/_/ /g;
- }
- return &ScriptLinkClass("action=edit&id=$id", $name, 'wikipageedit');
- }
- sub GetDeleteLink {
- my ($id, $name, $confirm) = @_;
- if ($FreeLinks) {
- $id = &FreeToNormal($id);
- $name =~ s/_/ /g;
- }
- return &ScriptLink("action=delete&id=$id&confirm=$confirm", $name);
- }
- sub GetOldPageParameters {
- my ($kind, $id, $revision) = @_;
- $id = &FreeToNormal($id) if $FreeLinks;
- return "action=$kind&id=$id&revision=$revision";
- }
- sub GetOldPageLink {
- my ($kind, $id, $revision, $name) = @_;
- $name =~ s/_/ /g if $FreeLinks;
- return &ScriptLink(&GetOldPageParameters($kind, $id, $revision), $name);
- }
- sub GetPageOrEditAnchoredLink {
- my ($id, $anchor, $name) = @_;
- my (@temp, $exists);
- if ($name eq "") {
- $name = $id;
- if ($FreeLinks) {
- $name =~ s/_/ /g;
- }
- }
- $id =~ s|^/|$MainPage/|;
- if ($FreeLinks) {
- $id = &FreeToNormal($id);
- }
- $exists = 0;
- if ($UseIndex) {
- if (!$IndexInit) {
- @temp = &AllPagesList(); # Also initializes hash
- }
- $exists = 1 if ($IndexHash{$id});
- } elsif (-f &GetPageFile($id)) { # Page file exists
- $exists = 1;
- }
- if ($exists) {
- $id = "$id#$anchor" if $anchor;
- $name = "$name#$anchor" if $anchor && $NamedAnchors != 2;
- return &GetPageLinkText($id, $name);
- }
- if ($FreeLinks && !$EditNameLink) {
- if ($name =~ m| |) { # Not a single word
- $name = "[$name]"; # Add brackets so boundaries are obvious
- }
- }
- if ($EditNameLink) {
- return &GetEditLink($id, $name);
- } else {
- return $name . &GetEditLink($id, '?');
- }
- }
- sub GetPageOrEditLink {
- my ($id, $name) = @_;
- return &GetPageOrEditAnchoredLink($id, "", $name);
- }
- sub GetBackLinksSearchLink {
- my ($id) = @_;
- my $name = $id;
- $id =~ s|.+/|/|; # Subpage match: search for just /SubName
- if ($FreeLinks) {
- $name =~ s/_/ /g; # Display with spaces
- $id =~ s/_/+/g; # Search for url-escaped spaces
- }
- return &ScriptLink("back=$id", $name);
- }
- sub GetPrefsLink {
- return &ScriptLink("action=editprefs", T('Preferences'));
- }
- sub GetRandomLink {
- return &ScriptLink("action=random", T('Random Page'));
- }
- sub ScriptLinkDiff {
- my ($diff, $id, $text, $rev) = @_;
- $rev = "&revision=$rev" if ($rev ne "");
- $diff = &GetParam("defaultdiff", 1) if ($diff == 4);
- return &ScriptLink("action=browse&diff=$diff&id=$id$rev", $text);
- }
- sub ScriptLinkDiffRevision {
- my ($diff, $id, $rev, $text) = @_;
- $rev = "&diffrevision=$rev" if ($rev ne "");
- $diff = &GetParam("defaultdiff", 1) if ($diff == 4);
- return &ScriptLink("action=browse&diff=$diff&id=$id$rev", $text);
- }
- sub GetUploadLink {
- return &ScriptLink('action=upload', T('Upload'));
- }
- sub ScriptLinkTitle {
- my ($action, $text, $title) = @_;
- if ($FreeLinks) {
- $action =~ s/ /_/g;
- }
- return '<a href="' . $ScriptName . &ScriptLinkChar() . &UriEscape($action)
- . "\" title=\"$title\">$text</a>";
- }
- sub GetAuthorLink {
- my ($host, $userName, $uid) = @_;
- my ($html, $title, $userNameShow);
- $userNameShow = $userName;
- if ($FreeLinks) {
- $userName =~ s/ /_/g;
- $userNameShow =~ s/_/ /g;
- }
- if (&ValidId($userName) ne "") { # Invalid under current rules
- $userName = ""; # Just pretend it isn't there.
- }
- if (($uid > 0) && ($userName ne "")) {
- $html = &ScriptLinkTitle($userName, $userNameShow,
- Ts('ID %s', $uid) . ' ' . Ts('from %s', $host));
- } else {
- $html = $host;
- }
- return $html;
- }
- sub GetHistoryLink {
- my ($id, $text) = @_;
- if ($FreeLinks) {
- $id =~ s/ /_/g;
- }
- return &ScriptLink("action=history&id=$id", $text);
- }
- sub GetHeader {
- my ($id, $title, $oldId, $backlinks) = @_;
- my $header = "";
- my $logoImage = "";
- my $result = "";
- my $embed = &GetParam('embed', $EmbedWiki);
- my $altText = T('[Home]');
- $result = &GetHttpHeader('');
- if ($FreeLinks) {
- $title =~ s/_/ /g; # Display as spaces
- }
- $result .= &GetHtmlHeader("$SiteName: $title");
- return $result if ($embed);
- $result .= '<div class=wikiheader>';
- if ($oldId ne '') {
- $result .= $q->h3('(' . Ts('redirected from %s',
- &GetEditLink($oldId, &QuoteHtml($oldId)), 1) . ')');
- }
- if ((!$embed) && ($LogoUrl ne "")) {
- $logoImage = "img src=\"$LogoUrl\" alt=\"$altText\" border=0";
- if (!$LogoLeft) {
- $logoImage .= " align=\"right\"";
- }
- $header = &ScriptLink($HomePage, "<$logoImage>");
- }
- if ($id and $backlinks) {
- $result .= $q->h1($header . &GetBackLinksSearchLink($id));
- } else {
- $result .= $q->h1($header . $title);
- }
- if (&GetParam("toplinkbar", 1)) {
- $result .= &GetGotoBar($id) . "<hr class=wikilineheader>";
- }
- $result .= '</div>';
- return $result;
- }
- sub GetHttpHeader {
- my ($type) = @_;
- my $cookie;
- $type = 'text/html' if ($type eq '');
- if (defined($SetCookie{'id'})) {
- $cookie = "$CookieName="
- . "rev&" . $SetCookie{'rev'}
- . "&id&" . $SetCookie{'id'}
- . "&randkey&" . $SetCookie{'randkey'};
- $cookie .= ";expires=Fri, 08-Sep-2013 19:48:23 GMT";
- if ($HttpCharset ne '') {
- return $q->header(-cookie=>$cookie,
- -type=>"$type; charset=$HttpCharset");
- }
- return $q->header(-cookie=>$cookie);
- }
- if ($HttpCharset ne '') {
- return $q->header(-type=>"$type; charset=$HttpCharset");
- }
- return $q->header(-type=>$type);
- }
- sub GetHtmlHeader {
- my ($title) = @_;
- my ($dtd, $html, $bodyExtra, $stylesheet);
- $html = '';
- $dtd = '-//IETF//DTD HTML//EN';
- $html = qq(<!DOCTYPE HTML PUBLIC "$dtd">\n);
- $title = $q->escapeHTML($title);
- $html .= "<HTML><HEAD><TITLE>$title</TITLE>\n";
- if ($FavIcon ne '') {
- $html .= '<LINK REL="SHORTCUT ICON" HREF="' . $FavIcon . '">'
- }
- if ($MetaKeywords) {
- my $keywords = $OpenPageName;
- $keywords =~ s/([a-z])([A-Z])/$1, $2/g;
- $html .= "<META NAME='KEYWORDS' CONTENT='$keywords'/>\n" if $keywords;
- }
- # we don't want robots indexing our history or other admin pages
- my $action = lc(&GetParam('action', ''));
- unless (!$action or $action eq "rc" or $action eq "index") {
- $html .= "<META NAME='robots' CONTENT='noindex,nofollow'>\n";
- }
- if ($SiteBase ne "") {
- $html .= qq(<BASE HREF="$SiteBase">\n);
- }
- $stylesheet = &GetParam('stylesheet', $StyleSheet);
- $stylesheet = $StyleSheet if ($stylesheet eq '');
- $stylesheet = '' if ($stylesheet eq '*'); # Allow removing override
- if ($stylesheet ne '') {
- $html .= qq(<LINK REL="stylesheet" HREF="$stylesheet">\n);
- }
- $html .= $UserHeader;
- $bodyExtra = '';
- if ($UserBody ne '') {
- $bodyExtra = ' ' . $UserBody;
- }
- if ($BGColor ne '') {
- $bodyExtra .= qq( BGCOLOR="$BGColor");
- }
- $html .= "</HEAD><BODY$bodyExtra>\n";
- return $html;
- }
- sub GetFooterText {
- my ($id, $rev) = @_;
- my $result;
- if (&GetParam('embed', $EmbedWiki)) {
- return $q->end_html;
- }
- $result = '<div class=wikifooter>';
- $result .= "<hr class=wikilinefooter>\n";
- $result .= &GetFormStart();
- $result .= &GetGotoBar($id);
- if (&UserCanEdit($id, 0)) {
- if ($rev ne '') {
- $result .= &GetOldPageLink('edit', $id, $rev,
- Ts('Edit revision %s of this page', $rev));
- } else {
- $result .= &GetEditLink($id, T('Edit text of this page'));
- }
- } else {
- $result .= T('This page is read-only');
- }
- $result .= ' | ';
- $result .= &GetHistoryLink($id, T('View other revisions'));
- if ($rev ne '') {
- $result .= ' | ';
- $result .= &GetPageLinkText($id, T('View current revision'));
- }
- if ($UseMetaWiki) {
- $result .= ' | <a href="http://sunir.org/apps/meta.pl?' . &UriEscape($id) . '">'
- . T('Search MetaWiki') . '</a>';
- }
- if ($Section{'revision'} > 0) {
- $result .= '<br>';
- if ($rev eq '') { # Only for most current rev
- $result .= T('Last edited');
- } else {
- $result .= T('Edited');
- }
- $result .= ' ' . &TimeToText($Section{ts});
- if ($AuthorFooter) {
- $result .= ' ' . Ts('by %s', &GetAuthorLink($Section{'host'},
- $Section{'username'}, $Section{'id'}), 1);
- }
- }
- if ($UseDiff) {
- $result .= ' ' . &ScriptLinkDiff(4, $id, T('(diff)'), $rev);
- }
- $result .= '<br>' . &GetSearchForm();
- if ($AdminBar && &UserIsAdmin()) {
- $result .= '<br>' . &GetAdminBar($id);
- }
- if ($DataDir =~ m|/tmp/|) {
- $result .= '<br><b>' . T('Warning') . ':</b> '
- . Ts('Database is stored in temporary directory %s',
- $DataDir) . '<br>';
- }
- if ($ConfigError ne '') {
- $result .= '<br><b>' . T('Config file error:') . '</b> '
- . $ConfigError . '<br>';
- }
- $result .= $q->endform;
- if ($FooterNote ne '') {
- $result .= T($FooterNote);
- }
- $result .= '</div>';
- $result .= &GetMinimumFooter();
- return $result;
- }
- sub GetCommonFooter {
- my ($html);
- $html = '<div class=wikifooter>' . '<hr class=wikilinefooter>'
- . &GetFormStart() . &GetGotoBar('')
- . &GetSearchForm() . $q->endform;
- if ($FooterNote ne '') {
- $html .= T($FooterNote);
- }
- $html .= '</div>' . $q->end_html;
- return $html;
- }
- sub GetMinimumFooter {
- return $q->end_html;
- }
- sub GetFormStart {
- return $q->startform("POST", "$ScriptName",
- "application/x-www-form-urlencoded");
- }
- sub GetGotoBar {
- my ($id) = @_;
- my ($main, $bartext);
- $bartext = &GetPageLink($HomePage);
- if ($id =~ m|/|) {
- $main = $id;
- $main =~ s|/.*||; # Only the main page name (remove subpage)
- $bartext .= " | " . &GetPageLink($main);
- }
- $bartext .= " | " . &GetPageLink($RCName);
- $bartext .= " | " . &GetPrefsLink();
- if ($UseUpload && &UserCanUpload()) {
- $bartext .= " | " . &GetUploadLink();
- }
- if (&GetParam("linkrandom", 0)) {
- $bartext .= " | " . &GetRandomLink();
- }
- if ($UserGotoBar ne '') {
- $bartext .= " | " . $UserGotoBar;
- }
- $bartext .= "<br>\n";
- return $bartext;
- }
- # Admin bar contributed by ElMoro (with some changes)
- sub GetPageLockLink {
- my ($id, $status, $name) = @_;
- if ($FreeLinks) {
- $id = &FreeToNormal($id);
- }
- return &ScriptLink("action=pagelock&set=$status&id=$id", $name);
- }
- sub GetAdminBar {
- my ($id) = @_;
- my ($result);
- $result = T('Administration') . ': ';
- if (-f &GetLockedPageFile($id)) {
- $result .= &GetPageLockLink($id, 0, T('Unlock page'));
- }
- else {
- $result .= &GetPageLockLink($id, 1, T('Lock page'));
- }
- $result .= " | " . &GetDeleteLink($id, T('Delete this page'), 0);
- $result .= " | " . &ScriptLink("action=editbanned", T("Edit Banned List"));
- $result .= " | " . &ScriptLink("action=maintain", T("Run Maintenance"));
- $result .= " | " . &ScriptLink("action=editlinks", T("Edit/Rename pages"));
- if (-f "$DataDir/noedit") {
- $result .= " | " . &ScriptLink("action=editlock&set=0", T("Unlock site"));
- } else {
- $result .= " | " . &ScriptLink("action=editlock&set=1", T("Lock site"));
- }
- return $result;
- }
- sub GetSearchForm {
- my ($result);
- $result = T('Search:') . ' ' . $q->textfield(-name=>'search', -size=>20);
- if ($SearchButton) {
- $result .= $q->submit('dosearch', T('Go!'));
- } else {
- $result .= &GetHiddenValue("dosearch", 1);
- }
- return $result;
- }
- sub GetRedirectPage {
- my ($newid, $name, $isEdit) = @_;
- my ($url, $html);
- my ($nameLink);
- # Normally get URL from script, but allow override.
- $FullUrl = $q->url(-full=>1) if ($FullUrl eq "");
- $url = $FullUrl . &ScriptLinkChar() . &UriEscape($newid);
- $nameLink = "<a href=\"$url\">$name</a>";
- if ($RedirType < 3) {
- if ($RedirType == 1) { # Use CGI.pm
- # NOTE: do NOT use -method (does not work with old CGI.pm versions)
- # Thanks to Daniel Neri for fixing this problem.
- $html = $q->redirect(-uri=>$url);
- } else { # Minimal header
- $html = "Status: 302 Moved\n";
- $html .= "Location: $url\n";
- $html .= "Content-Type: text/html\n"; # Needed for browser failure
- $html .= "\n";
- }
- $html .= "\n" . Ts('Your browser should go to the %s page.', $newid);
- $html .= ' ' . Ts('If it does not, click %s to continue.', $nameLink);
- } else {
- if ($isEdit) {
- $html = &GetHeader('', T('Thanks for editing...'), '');
- $html .= Ts('Thank you for editing %s.', $nameLink);
- } else {
- $html = &GetHeader('', T('Link to another page...'), '');
- }
- $html .= "\n<p>";
- $html .= Ts('Follow the %s link to continue.', $nameLink);
- $html .= &GetMinimumFooter();
- }
- return $html;
- }
- # ==== Common wiki markup ====
- sub RestoreSavedText {
- my ($text) = @_;
- 1 while $text =~ s/$FS(\d+)$FS/$SaveUrl{$1}/ge; # Restore saved text
- return $text;
- }
- sub RemoveFS {
- my ($text) = @_;
- # Note: must remove all $FS, and $FS may be multi-byte/char separator
- $text =~ s/($FS)+(\d)/$2/g;
- return $text;
- }
- sub WikiToHTML {
- my ($pageText) = @_;
- $TableMode = 0;
- %SaveUrl = ();
- %SaveNumUrl = ();
- $SaveUrlIndex = 0;
- $SaveNumUrlIndex = 0;
- $pageText = &RemoveFS($pageText);
- if ($RawHtml) {
- $pageText =~ s/<html>((.|\n)*?)<\/html>/&StoreRaw($1)/ige;
- }
- $pageText = &QuoteHtml($pageText);
- $pageText =~ s/\\ *\r?\n/ /g; # Join lines with backslash at end
- if ($ParseParas) {
- # Note: The following 3 rules may span paragraphs, so they are
- # copied from CommonMarkup
- $pageText =~
- s/\<nowiki\>((.|\n)*?)\<\/nowiki\>/&StoreRaw($1)/ige;
- $pageText =~
- s/\<pre\>((.|\n)*?)\<\/pre\>/&StorePre($1, "pre")/ige;
- $pageText =~
- s/\<code\>((.|\n)*?)\<\/code\>/&StorePre($1, "code")/ige;
- $pageText =~ s/((.|\n)+?\n)\s*(\n|$)/&ParseParagraph($1)/geo;
- $pageText =~ s/(.*)<\/p>(.+)$/$1.&ParseParagraph($2)/seo;
- } else {
- $pageText = &CommonMarkup($pageText, 1, 0); # Multi-line markup
- $pageText = &WikiLinesToHtml($pageText); # Line-oriented markup
- }
- while (@HeadingNumbers) {
- pop @HeadingNumbers;
- $TableOfContents .= "</dd></dl>\n\n";
- }
- $pageText =~ s/<toc>/$TableOfContents/gi;
- if ($LateRules ne '') {
- $pageText = &EvalLocalRules($LateRules, $pageText, 0);
- }
- return &RestoreSavedText($pageText);
- }
- sub CommonMarkup {
- my ($text, $useImage, $doLines) = @_;
- local $_ = $text;
- if ($doLines < 2) { # 2 = do line-oriented only
- # The <nowiki> tag stores text with no markup (except quoting HTML)
- s/\<nowiki\>((.|\n)*?)\<\/nowiki\>/&StoreRaw($1)/ige;
- # The <pre> tag wraps the stored text with the HTML <pre> tag
- s/\<pre\>((.|\n)*?)\<\/pre\>/&StorePre($1, "pre")/ige;
- s/\<code\>((.|\n)*?)\<\/code\>/&StorePre($1, "code")/ige;
- if ($EarlyRules ne '') {
- $_ = &EvalLocalRules($EarlyRules, $_, !$useImage);
- }
- s/\[\#(\w+)\]/&StoreHref(" name=\"$1\"")/ge if $NamedAnchors;
- if ($HtmlTags) {
- my ($t);
- foreach $t (@HtmlPairs) {
- s/\<$t(\s[^<>]+?)?\>(.*?)\<\/$t\>/<$t$1>$2<\/$t>/gis;
- }
- foreach $t (@HtmlSingle) {
- s/\<$t(\s[^<>]+?)?\>/<$t$1>/gi;
- }
- } else {
- # Note that these tags are restricted to a single line
- s/\<b\>(.*?)\<\/b\>/<b>$1<\/b>/gi;
- s/\<i\>(.*?)\<\/i\>/<i>$1<\/i>/gi;
- s/\<strong\>(.*?)\<\/strong\>/<strong>$1<\/strong>/gi;
- s/\<em\>(.*?)\<\/em\>/<em>$1<\/em>/gi;
- }
- s/\<tt\>(.*?)\<\/tt\>/<tt>$1<\/tt>/gis; # <tt> (MeatBall)
- s/\<br\>/<br>/gi; # Allow simple line break anywhere
- if ($HtmlLinks) {
- s/\<A(\s[^<>]+?)\>(.*?)\<\/a\>/&StoreHref($1, $2)/gise;
- }
- if ($FreeLinks) {
- # Consider: should local free-link descriptions be conditional?
- # Also, consider that one could write [[Bad Page|Good Page]]?
- s/\[\[$FreeLinkPattern\|([^\]]+)\]\]/&StorePageOrEditLink($1, $2)/geo;
- s/\[\[$FreeLinkPattern\]\]/&StorePageOrEditLink($1, "")/geo;
- }
- if ($BracketText) { # Links like [URL text of link]
- s/\[$UrlPattern\s+([^\]]+?)\]/&StoreBracketUrl($1, $2, $useImage)/geos;
- s/\[$InterLinkPattern\s+([^\]]+?)\]/&StoreBracketInterPage($1, $2,
- $useImage)/geos;
- if ($WikiLinks && $BracketWiki) { # Local bracket-links
- s/\[$LinkPattern\s+([^\]]+?)\]/&StoreBracketLink($1, $2)/geos;
- s/\[$AnchoredLinkPattern\s+([^\]]+?)\]/&StoreBracketAnchoredLink($1,
- $2, $3)/geos if $NamedAnchors;
- }
- }
- s/\[$UrlPattern\]/&StoreBracketUrl($1, "", 0)/geo;
- s/\[$InterLinkPattern\]/&StoreBracketInterPage($1, "", 0)/geo;
- s/\b$UrlPattern/&StoreUrl($1, $useImage)/geo;
- s/\b$InterLinkPattern/&StoreInterPage($1, $useImage)/geo;
- if ($UseUpload) {
- s/$UploadPattern/&StoreUpload($1)/geo;
- }
- if ($WikiLinks) {
- s/$AnchoredLinkPattern/&StoreRaw(&GetPageOrEditAnchoredLink($1,
- $2, ""))/geo if $NamedAnchors;
- # CAA: Putting \b in front of $LinkPattern breaks /SubPage links
- # (subpage links without the main page)
- s/$LinkPattern/&GetPageOrEditLink($1, "")/geo;
- }
- s/\b$RFCPattern/&StoreRFC($1)/geo;
- s/\b$ISBNPattern/&StoreISBN($1)/geo;
- if ($ThinLine) {
- if ($OldThinLine) { # Backwards compatible, conflicts with headers
- s/====+/<hr noshade class=wikiline size=2>/g;
- } else { # New behavior--no conflict
- s/------+/<hr noshade class=wikiline size=2>/g;
- }
- s/----+/<hr noshade class=wikiline size=1>/g;
- } else {
- s/----+/<hr class=wikiline>/g;
- }
- }
- if ($doLines) { # 0 = no line-oriented, 1 or 2 = do line-oriented
- # The quote markup patterns avoid overlapping tags (with 5 quotes)
- # by matching the inner quotes for the strong pattern.
- s/('*)'''(.*?)'''/$1<strong>$2<\/strong>/g;
- s/''(.*?)''/<em>$1<\/em>/g;
- if ($UseHeadings) {
- s/(^|\n)\s*(\=+)\s+([^\n]+)\s+\=+/&WikiHeading($1, $2, $3)/geo;
- }
- if ($TableMode) {
- s/((\|\|)+)/"<\/TD><TD COLSPAN=\"" . (length($1)\/2) . "\">"/ge;
- }
- }
- return $_;
- }
- sub EmptyCellsToNbsp {
- my ($row) = @_;
- $row =~ s/(?<=\|\|)\s+(?=\|\|)/ /g;
- $row =~ s/^\s+(?=\|\|)/ /;
- $row =~ s/(?<=\|\|)\s+$/ /;
- return $row;
- }
- sub WikiLinesToHtml {
- my ($pageText) = @_;
- my ($pageHtml, @htmlStack, $code, $codeAttributes, $depth, $oldCode);
- @htmlStack = ();
- $depth = 0;
- $pageHtml = "";
- foreach (split(/\n/, $pageText)) { # Process lines one-at-a-time
- $code = '';
- $codeAttributes = '';
- $TableMode = 0;
- $_ .= "\n";
- if (s/^(\;+)([^:]+\:?)\:/<dt>$2<dd>/) {
- $code = "DL";
- $depth = length $1;
- } elsif (s/^(\:+)/<dt><dd>/) {
- $code = "DL";
- $depth = length $1;
- } elsif (s/^(\*+)/<li>/) {
- $code = "UL";
- $depth = length $1;
- } elsif (s/^(\#+)/<li>/) {
- $code = "OL";
- $depth = length $1;
- } elsif ($TableSyntax &&
- s/^((\|\|)+)(.*)\|\|\s*$/"<TR VALIGN='CENTER' "
- . "ALIGN='CENTER'><TD colspan='"
- . (length($1)\/2) . "'>" . EmptyCellsToNbsp($3) . "<\/TD><\/TR>\n"/e) {
- $code = 'TABLE';
- $codeAttributes = "BORDER='1'";
- $TableMode = 1;
- $depth = 1;
- } elsif (/^[ \t].*\S/) {
- $code = "PRE";
- $depth = 1;
- } else {
- $depth = 0;
- }
- while (@htmlStack > $depth) { # Close tags as needed
- $pageHtml .= "</" . pop(@htmlStack) . ">\n";
- }
- if ($depth > 0) {
- $depth = $IndentLimit if ($depth > $IndentLimit);
- if (@htmlStack) { # Non-empty stack
- $oldCode = pop(@htmlStack);
- if ($oldCode ne $code) {
- $pageHtml .= "</$oldCode><$code>\n";
- }
- push(@htmlStack, $code);
- }
- while (@htmlStack < $depth) {
- push(@htmlStack, $code);
- $pageHtml .= "<$code $codeAttributes>\n";
- }
- }
- if (!$ParseParas) {
- s/^\s*$/<p>\n/; # Blank lines become <p> tags
- }
- $pageHtml .= &CommonMarkup($_, 1, 2); # Line-oriented common markup
- }
- while (@htmlStack > 0) { # Clear stack
- $pageHtml .= "</" . pop(@htmlStack) . ">\n";
- }
- return $pageHtml;
- }
- sub EvalLocalRules {
- my ($rules, $origText, $isDiff) = @_;
- my ($text, $reportError, $errorText);
- $text = $origText;
- $reportError = 1;
- # Basic idea: the $rules should change $text, possibly with different
- # behavior if $isDiff is true (no images or color changes?)
- # Note: for fun, the $rules could also change $reportError and $origText
- if (!eval $rules) {
- $errorText = $@;
- if ($errorText eq '') {
- # Search for "Unknown Error" for the reason the next line is commented
- # $errorText = T('Unknown Error (no error text)');
- }
- if ($errorText ne '') {
- $text = $origText; # Consider: should partial results be kept?
- if ($reportError) {
- $text .= '<hr><b>' . T('Local rule error:') . '</b><br>'
- . &QuoteHtml($errorText);
- }
- }
- }
- return $text;
- }
-
- sub UriEscape {
- my ($uri) = @_;
- $uri =~ s/([\x00-\x1f\x7f-\xff])/sprintf("%%%02X", ord($1))/ge;
- $uri =~ s/\&/\&/g;
- return $uri;
- }
- sub ParseParagraph {
- my ($text) = @_;
- $text = &CommonMarkup($text, 1, 0); # Multi-line markup
- $text = &WikiLinesToHtml($text); # Line-oriented markup
- return "<p>$text</p>\n";
- }
- sub StoreInterPage {
- my ($id, $useImage) = @_;
- my ($link, $extra);
- ($link, $extra) = &InterPageLink($id, $useImage);
- # Next line ensures no empty links are stored
- $link = &StoreRaw($link) if ($link ne "");
- return $link . $extra;
- }
- sub InterPageLink {
- my ($id, $useImage) = @_;
- my ($name, $site, $remotePage, $url, $punct);
- ($id, $punct) = &SplitUrlPunct($id);
- $name = $id;
- ($site, $remotePage) = split(/:/, $id, 2);
- $url = &GetSiteUrl($site);
- return ("", $id . $punct) if ($url eq "");
- $remotePage =~ s/&/&/g; # Unquote common URL HTML
- $url .= $remotePage;
- return (&UrlLinkOrImage($url, $name, $useImage), $punct);
- }
- sub StoreBracketInterPage {
- my ($id, $text, $useImage) = @_;
- my ($site, $remotePage, $url, $index);
- ($site, $remotePage) = split(/:/, $id, 2);
- $remotePage =~ s/&/&/g; # Unquote common URL HTML
- $url = &GetSiteUrl($site);
- if ($text ne "") {
- return "[$id $text]" if ($url eq "");
- } else {
- return "[$id]" if ($url eq "");
- $text = &GetBracketUrlIndex($id);
- }
- $url .= $remotePage;
- if ($BracketImg && $useImage && &ImageAllowed($text)) {
- $text = "<img src=\"$text\">";
- } else {
- $text = "[$text]";
- }
- return &StoreRaw("<a href=\"$url\">$text</a>");
- }
- sub GetBracketUrlIndex {
- my ($id) = @_;
- my ($index, $key);
- # Consider plain array?
- if ($SaveNumUrl{$id} > 0) {
- return $SaveNumUrl{$id};
- }
- $SaveNumUrlIndex++; # Start with 1
- $SaveNumUrl{$id} = $SaveNumUrlIndex;
- return $SaveNumUrlIndex;
- }
- sub GetSiteUrl {
- my ($site) = @_;
- my ($data, $status);
- if (!$InterSiteInit) {
- ($status, $data) = &ReadFile($InterFile);
- if ($status) {
- %InterSite = split(/\s+/, $data); # Consider defensive code
- }
- # Check for definitions to allow file to override automatic settings
- if (!defined($InterSite{'LocalWiki'})) {
- $InterSite{'LocalWiki'} = $ScriptName . &ScriptLinkChar();
- }
- if (!defined($InterSite{'Local'})) {
- $InterSite{'Local'} = $ScriptName . &ScriptLinkChar();
- }
- $InterSiteInit = 1; # Init only once per request
- }
- return $InterSite{$site} if (defined($InterSite{$site}));
- return '';
- }
- sub StoreRaw {
- my ($html) = @_;
- $SaveUrl{$SaveUrlIndex} = $html;
- return $FS . $SaveUrlIndex++ . $FS;
- }
- sub StorePre {
- my ($html, $tag) = @_;
- return &StoreRaw("<$tag>" . $html . "</$tag>");
- }
- sub StoreHref {
- my ($anchor, $text) = @_;
- return "<a" . &StoreRaw($anchor) . ">$text</a>";
- }
- sub StoreUrl {
- my ($name, $useImage) = @_;
- my ($link, $extra);
- ($link, $extra) = &UrlLink($name, $useImage);
- # Next line ensures no empty links are stored
- $link = &StoreRaw($link) if ($link ne "");
- return $link . $extra;
- }
- sub UrlLink {
- my ($rawname, $useImage) = @_;
- my ($name, $punct);
- ($name, $punct) = &SplitUrlPunct($rawname);
- if ($LimitFileUrl && ($NetworkFile && $name =~ m|^file:|)) {
- # Only do remote file:// links. No file:///c|/windows.
- if ($name =~ m|^file://[^/]|) {
- return ("<a href=\"$name\">$name</a>", $punct);
- }
- return ($rawname, '');
- }
- return (&UrlLinkOrImage($name, $name, $useImage), $punct);
- }
- sub UrlLinkOrImage {
- my ($url, $name, $useImage) = @_;
- # Restricted image URLs so that mailto:foo@bar.gif is not an image
- if ($useImage && &ImageAllowed($url)) {
- return "<img src=\"$url\">";
- }
- return "<a href=\"$url\">$name</a>";
- }
- sub ImageAllowed {
- my ($url) = @_;
- my ($site, $imagePrefixes);
- $imagePrefixes = 'http:|https:|ftp:';
- $imagePrefixes .= '|file:' if (!$LimitFileUrl);
- return 0 unless ($url =~ /^($imagePrefixes).+\.$ImageExtensions$/i);
- return 0 if ($url =~ /"/); # No HTML-breaking quotes allowed
- return 1 if (@ImageSites < 1); # Most common case: () means all allowed
- return 0 if ($ImageSites[0] eq 'none'); # Special case: none allowed
- foreach $site (@ImageSites) {
- return 1 if ($site eq substr($url, 0, length($site))); # Match prefix
- }
- return 0;
- }
- sub StoreBracketUrl {
- my ($url, $text, $useImage) = @_;
- if ($text eq "") {
- $text = &GetBracketUrlIndex($url);
- } elsif ($text =~ /^$InterLinkPattern$/) {
- my @interlink = split(/:/, $text, 2);
- $text = &GetSiteUrl($interlink[0]) . $interlink[1];
- }
- if ($BracketImg && $useImage && &ImageAllowed($text)) {
- $text = "<img src=\"$text\">";
- } else {
- $text = "[$text]";
- }
- return &StoreRaw("<a href=\"$url\">$text</a>");
- }
- sub StoreBracketLink {
- my ($name, $text) = @_;
- return &StoreRaw(&GetPageLinkText($name, "[$text]"));
- }
- sub StoreBracketAnchoredLink {
- my ($name, $anchor, $text) = @_;
- return &StoreRaw(&GetPageLinkText("$name#$anchor", "[$text]"));
- }
- sub StorePageOrEditLink {
- my ($page, $name) = @_;
- if ($FreeLinks) {
- $page =~ s/^\s+//; # Trim extra spaces
- $page =~ s/\s+$//;
- $page =~ s|\s*/\s*|/|; # ...also before/after subpages
- }
- $name =~ s/^\s+//;
- $name =~ s/\s+$//;
- return &StoreRaw(&GetPageOrEditLink($page, $name));
- }
- sub StoreRFC {
- my ($num) = @_;
- return &StoreRaw(&RFCLink($num));
- }
- sub RFCLink {
- my ($num) = @_;
- return "<a href=\"http://www.faqs.org/rfcs/rfc${num}.html\">RFC $num</a>";
- }
- sub StoreUpload {
- my ($url) = @_;
- return &StoreRaw(&UploadLink($url));
- }
- sub UploadLink {
- my ($filename) = @_;
- my ($html, $url);
-
- return $filename if ($UploadUrl eq ''); # No bad links if misconfigured
- $UploadUrl .= '/' if (substr($UploadUrl, -1, 1) ne '/'); # End with /
- $url = $UploadUrl . $filename;
- $html = '<a href="' . $url . '">';
- if (&ImageAllowed($url)) {
- $html .= '<img src="' . $url . '" alt="upload:' . $filename . '">';
- } else {
- $html .= 'upload:' . $filename;
- }
- $html .= '</a>';
- return $html;
- }
- sub StoreISBN {
- my ($num) = @_;
- return &StoreRaw(&ISBNLink($num));
- }
- sub ISBNALink {
- my ($num, $pre, $post, $text) = @_;
- return '<a href="' . $pre . $num . $post . '">' . $text . '</a>';
- }
- sub ISBNLink {
- my ($rawnum) = @_;
- my ($rawprint, $html, $num, $numSites, $i);
- $num = $rawnum;
- $rawprint = $rawnum;
- $rawprint =~ s/ +$//;
- $num =~ s/[- ]//g;
- $numSites = scalar @IsbnNames; # Number of entries
- if ((length($num) != 10) || ($numSites < 1)) {
- return "ISBN $rawnum";
- }
- $html = &ISBNALink($num, $IsbnPre[0], $IsbnPost[0], 'ISBN ' . $rawprint);
- if ($numSites > 1) {
- $html .= ' (';
- $i = 1;
- while ($i < $numSites) {
- $html .= &ISBNALink($num, $IsbnPre[$i], $IsbnPost[$i], $IsbnNames[$i]);
- if ($i < ($numSites - 1)) { # Not the last site
- $html .= ', ';
- }
- $i++;
- }
- $html .= ')';
- }
- $html .= " " if ($rawnum =~ / $/); # Add space if old ISBN had space.
- return $html;
- }
- sub SplitUrlPunct {
- my ($url) = @_;
- my ($punct);
- if ($url =~ s/\"\"$//) {
- return ($url, ""); # Delete double-quote delimiters here
- }
- $punct = "";
- if ($NewFS) {
- ($punct) = ($url =~ /([^a-zA-Z0-9\/\x80-\xff]+)$/);
- $url =~ s/([^a-zA-Z0-9\/\x80-\xff]+)$//;
- } else {
- ($punct) = ($url =~ /([^a-zA-Z0-9\/\xc0-\xff]+)$/);
- $url =~ s/([^a-zA-Z0-9\/\xc0-\xff]+)$//;
- }
- return ($url, $punct);
- }
- sub StripUrlPunct {
- my ($url) = @_;
- my ($junk);
- ($url, $junk) = &SplitUrlPunct($url);
- return $url;
- }
- sub WikiHeadingNumber {
- my ($depth, $text) = @_;
- my ($anchor, $number);
- return '' unless --$depth > 0; # Don't number H1s because it looks stupid
- while (scalar @HeadingNumbers < ($depth-1)) {
- push @HeadingNumbers, 1;
- $TableOfContents .= '<dl><dt> </dt><dd>';
- }
- if (scalar @HeadingNumbers < $depth) {
- push @HeadingNumbers, 0;
- $TableOfContents .= '<dl><dt> </dt><dd>';
- }
- while (scalar @HeadingNumbers > $depth) {
- pop @HeadingNumbers;
- $TableOfContents .= "</dd></dl>\n\n";
- }
- $HeadingNumbers[$#HeadingNumbers]++;
- $number = (join '.', @HeadingNumbers) . '. ';
- # Remove embedded links. THIS IS FRAGILE!
- $text = &RestoreSavedText($text);
- $text =~ s/\<a\s[^\>]*?\>\?\<\/a\>//si; # No such page syntax
- $text =~ s/\<a\s[^\>]*?\>(.*?)\<\/a\>/$1/si;
- # Cook anchor by canonicalizing $text.
- $anchor = $text;
- $anchor =~ s/\<.*?\>//g;
- $anchor =~ s/\W/_/g;
- $anchor =~ s/__+/_/g;
- $anchor =~ s/^_//;
- $anchor =~ s/_$//;
- # Last ditch effort
- $anchor = '_' . (join '_', @HeadingNumbers) unless $anchor;
- $TableOfContents .= $number . &ScriptLink("$OpenPageName#$anchor",$text)
- . "</dd>\n<dt> </dt><dd>";
- return &StoreHref(" name=\"$anchor\"") . $number;
- }
- sub WikiHeading {
- my ($pre, $depth, $text) = @_;
- $depth = length($depth);
- $depth = 6 if ($depth > 6);
- $text =~ s/^\s*#\s+/&WikiHeadingNumber($depth,$')/e; # $' == $POSTMATCH
- return $pre . "<H$depth>$text</H$depth>\n";
- }
- # ==== Difference markup and HTML ====
- sub GetDiffHTML {
- my ($diffType, $id, $revOld, $revNew, $newText) = @_;
- my ($html, $diffText, $diffTextTwo, $priorName, $links, $usecomma);
- my ($major, $minor, $author, $useMajor, $useMinor, $useAuthor, $cacheName);
- $links = "(";
- $usecomma = 0;
- $major = &ScriptLinkDiff(1, $id, T('major diff'), "");
- $minor = &ScriptLinkDiff(2, $id, T('minor diff'), "");
- $author = &ScriptLinkDiff(3, $id, T('author diff'), "");
- $useMajor = 1;
- $useMinor = 1;
- $useAuthor = 1;
- $diffType = &GetParam("defaultdiff", 1) if ($diffType == 4);
- if ($diffType == 1) {
- $priorName = T('major');
- $cacheName = 'major';
- $useMajor = 0;
- } elsif ($diffType == 2) {
- $priorName = T('minor');
- $cacheName = 'minor';
- $useMinor = 0;
- } elsif ($diffType == 3) {
- $priorName = T('author');
- $cacheName = 'author';
- $useAuthor = 0;
- }
- if ($revOld ne "") {
- # Note: OpenKeptRevisions must have been done by caller.
- # Eventually optimize if same as cached revision
- $diffText = &GetKeptDiff($newText, $revOld, 1); # 1 = get lock
- if ($diffText eq "") {
- $diffText = T('(The revisions are identical or unavailable.)');
- }
- } else {
- $diffText = &GetCacheDiff($cacheName);
- }
- $useMajor = 0 if ($useMajor && ($diffText eq &GetCacheDiff("major")));
- $useMinor = 0 if ($useMinor && ($diffText eq &GetCacheDiff("minor")));
- $useAuthor = 0 if ($useAuthor && ($diffText eq &GetCacheDiff("author")));
- $useMajor = 0 if ((!defined(&GetPageCache('oldmajor'))) ||
- (&GetPageCache("oldmajor") < 1));
- $useAuthor = 0 if ((!defined(&GetPageCache('oldauthor'))) ||
- (&GetPageCache("oldauthor") < 1));
- if ($useMajor) {
- $links .= $major;
- $usecomma = 1;
- }
- if ($useMinor) {
- $links .= ", " if ($usecomma);
- $links .= $minor;
- $usecomma = 1;
- }
- if ($useAuthor) {
- $links .= ", " if ($usecomma);
- $links .= $author;
- }
- if (!($useMajor || $useMinor || $useAuthor)) {
- $links .= T('no other diffs');
- }
- $links .= ")";
- if ((!defined($diffText)) || ($diffText eq "")) {
- $diffText = T('No diff available.');
- }
- if ($revOld ne "") {
- my $currentRevision = T('current revision');
- $currentRevision = Ts('revision %s', $revNew) if $revNew;
- $html = '<b>'
- . Tss("Difference (from revision %1 to %2)", $revOld, $currentRevision)
- . "</b>\n" . "$links<br>" . &DiffToHTML($diffText);
- } else {
- if (($diffType != 2) &&
- ((!defined(&GetPageCache("old$cacheName"))) ||
- (&GetPageCache("old$cacheName") < 1))) {
- $html = '<b>'
- . Ts('No diff available--this is the first %s revision.',
- $priorName) . "</b>\n$links";
- } else {
- $html = '<b>'
- . Ts('Difference (from prior %s revision)', $priorName)
- . "</b>\n$links<br>" . &DiffToHTML($diffText);
- }
- }
- @HeadingNumbers = ();
- $TableOfContents = '';
- return $html;
- }
- sub GetCacheDiff {
- my ($type) = @_;
- my ($diffText);
- $diffText = &GetPageCache("diff_default_$type");
- $diffText = &GetCacheDiff('minor') if ($diffText eq "1");
- $diffText = &GetCacheDiff('major') if ($diffText eq "2");
- return $diffText;
- }
- # Must be done after minor diff is set and OpenKeptRevisions called
- sub GetKeptDiff {
- my ($newText, $oldRevision, $lock) = @_;
- my (%sect, %data, $oldText);
- $oldText = "";
- if (defined($KeptRevisions{$oldRevision})) {
- %sect = split(/$FS2/, $KeptRevisions{$oldRevision}, -1);
- %data = split(/$FS3/, $sect{'data'}, -1);
- $oldText = $data{'text'};
- }
- return "" if ($oldText eq ""); # Old revision not found
- return &GetDiff($oldText, $newText, $lock);
- }
- sub GetDiff {
- my ($old, $new, $lock) = @_;
- my ($diff_out, $oldName, $newName);
- &CreateDir($TempDir);
- $oldName = "$TempDir/old_diff";
- $newName = "$TempDir/new_diff";
- if ($lock) {
- &RequestDiffLock() or return "";
- $oldName .= "_locked";
- $newName .= "_locked";
- }
- &WriteStringToFile($oldName, $old);
- &WriteStringToFile($newName, $new);
- $diff_out = `diff $oldName $newName`;
- &ReleaseDiffLock() if ($lock);
- $diff_out =~ s/\\ No newline.*\n//g; # Get rid of common complaint.
- # No need to unlink temp files--next diff will just overwrite.
- return $diff_out;
- }
- sub DiffToHTML {
- my ($html) = @_;
- my ($tChanged, $tRemoved, $tAdded);
- $tChanged = T('Changed:');
- $tRemoved = T('Removed:');
- $tAdded = T('Added:');
- $html =~ s/\n--+//g;
- # Note: Need spaces before <br> to be different from diff section.
- $html =~ s/(^|\n)(\d+.*c.*)/$1 <br><strong>$tChanged $2<\/strong><br>/g;
- $html =~ s/(^|\n)(\d+.*d.*)/$1 <br><strong>$tRemoved $2<\/strong><br>/g;
- $html =~ s/(^|\n)(\d+.*a.*)/$1 <br><strong>$tAdded $2<\/strong><br>/g;
- $html =~ s/\n((<.*\n)+)/&ColorDiff($1, $DiffColor1, 0)/ge;
- $html =~ s/\n((>.*\n)+)/&ColorDiff($1, $DiffColor2, 1)/ge;
- return $html;
- }
- sub ColorDiff {
- my ($diff, $color, $type) = @_;
- my ($colorHtml, $classHtml);
- $diff =~ s/(^|\n)[<>]/$1/g;
- $diff = &QuoteHtml($diff);
- # Do some of the Wiki markup rules:
- %SaveUrl = ();
- %SaveNumUrl = ();
- $SaveUrlIndex = 0;
- $SaveNumUrlIndex = 0;
- $diff = &RemoveFS($diff);
- $diff = &CommonMarkup($diff, 0, 1); # No images, all patterns
- if ($LateRules ne '') {
- $diff = &EvalLocalRules($LateRules, $diff, 1);
- }
- 1 while $diff =~ s/$FS(\d+)$FS/$SaveUrl{$1}/ge; # Restore saved text
- $diff =~ s/\r?\n/<br>/g;
- $colorHtml = '';
- if ($color ne '') {
- $colorHtml = " bgcolor=$color";
- }
- if ($type) {
- $classHtml = ' class=wikidiffnew';
- } else {
- $classHtml = ' class=wikidiffold';
- }
- return "<table width=\"95\%\"$colorHtml$classHtml><tr><td>\n" . $diff
- . "</td></tr></table>\n";
- }
- # ==== Database (Page, Section, Text, Kept, User) functions ====
- sub OpenNewPage {
- my ($id) = @_;
- %Page = ();
- $Page{'version'} = 3; # Data format version
- $Page{'revision'} = 0; # Number of edited times
- $Page{'tscreate'} = $Now; # Set once at creation
- $Page{'ts'} = $Now; # Updated every edit
- }
- sub OpenNewSection {
- my ($name, $data) = @_;
- %Section = ();
- $Section{'name'} = $name;
- $Section{'version'} = 1; # Data format version
- $Section{'revision'} = 0; # Number of edited times
- $Section{'tscreate'} = $Now; # Set once at creation
- $Section{'ts'} = $Now; # Updated every edit
- $Section{'ip'} = $ENV{REMOTE_ADDR};
- $Section{'host'} = ''; # Updated only for real edits (can be slow)
- $Section{'id'} = $UserID;
- $Section{'username'} = &GetParam("username", "");
- $Section{'data'} = $data;
- $Page{$name} = join($FS2, %Section); # Replace with save?
- }
- sub OpenNewText {
- my ($name) = @_; # Name of text (usually "default")
- %Text = ();
- if ($NewText ne '') {
- $Text{'text'} = T($NewText);
- } else {
- $Text{'text'} = T('Describe the new page here.') . "\n";
- }
- $Text{'text'} .= "\n" if (substr($Text{'text'}, -1, 1) ne "\n");
- $Text{'minor'} = 0; # Default as major edit
- $Text{'newauthor'} = 1; # Default as new author
- $Text{'summary'} = '';
- &OpenNewSection("text_$name", join($FS3, %Text));
- }
- sub GetPageFile {
- my ($id) = @_;
- return $PageDir . "/" . &GetPageDirectory($id) . "/$id.db";
- }
- sub OpenPage {
- my ($id) = @_;
- my ($fname, $data);
- if ($OpenPageName eq $id) {
- return;
- }
- %Section = ();
- %Text = ();
- $fname = &GetPageFile($id);
- if (-f $fname) {
- $data = &ReadFileOrDie($fname);
- %Page = split(/$FS1/, $data, -1); # -1 keeps trailing null fields
- } else {
- &OpenNewPage($id);
- }
- if ($Page{'version'} != 3) {
- &UpdatePageVersion();
- }
- $OpenPageName = $id;
- }
- sub OpenSection {
- my ($name) = @_;
- if (!defined($Page{$name})) {
- &OpenNewSection($name, "");
- } else {
- %Section = split(/$FS2/, $Page{$name}, -1);
- }
- }
- sub OpenText {
- my ($name) = @_;
- if (!defined($Page{"text_$name"})) {
- &OpenNewText($name);
- } else {
- &OpenSection("text_$name");
- %Text = split(/$FS3/, $Section{'data'}, -1);
- }
- }
- sub OpenDefaultText {
- &OpenText('default');
- }
- # Called after OpenKeptRevisions
- sub OpenKeptRevision {
- my ($revision) = @_;
- %Section = split(/$FS2/, $KeptRevisions{$revision}, -1);
- %Text = split(/$FS3/, $Section{'data'}, -1);
- }
- sub GetPageCache {
- my ($name) = @_;
- return $Page{"cache_$name"};
- }
- # Always call SavePage within a lock.
- sub SavePage {
- my $file = &GetPageFile($OpenPageName);
- $Page{'revision'} += 1; # Number of edited times
- $Page{'ts'} = $Now; # Updated every edit
- &CreatePageDir($PageDir, $OpenPageName);
- &WriteStringToFile($file, join($FS1, %Page));
- }
- sub SaveSection {
- my ($name, $data) = @_;
- $Section{'revision'} += 1; # Number of edited times
- $Section{'ts'} = $Now; # Updated every edit
- $Section{'ip'} = $ENV{REMOTE_ADDR};
- $Section{'id'} = $UserID;
- $Section{'username'} = &GetParam("username", "");
- $Section{'data'} = $data;
- $Page{$name} = join($FS2, %Section);
- }
- sub SaveText {
- my ($name) = @_;
- &SaveSection("text_$name", join($FS3, %Text));
- }
- sub SaveDefaultText {
- &SaveText('default');
- }
- sub SetPageCache {
- my ($name, $data) = @_;
- $Page{"cache_$name"} = $data;
- }
- sub UpdatePageVersion {
- &ReportError(T('Bad page version (or corrupt page).'));
- }
- sub KeepFileName {
- return $KeepDir . "/" . &GetPageDirectory($OpenPageName)
- . "/$OpenPageName.kp";
- }
- sub SaveKeepSection {
- my $file = &KeepFileName();
- my $data;
- return if ($Section{'revision'} < 1); # Don't keep "empty" revision
- $Section{'keepts'} = $Now;
- $data = $FS1 . join($FS2, %Section);
- &CreatePageDir($KeepDir, $OpenPageName);
- &AppendStringToFileLimited($file, $data, $KeepSize);
- }
- sub ExpireKeepFile {
- my ($fname, $data, @kplist, %tempSection, $expirets);
- my ($anyExpire, $anyKeep, $expire, %keepFlag, $sectName, $sectRev);
- my ($oldMajor, $oldAuthor);
- $fname = &KeepFileName();
- return if (!(-f $fname));
- $data = &ReadFileOrDie($fname);
- @kplist = split(/$FS1/, $data, -1); # -1 keeps trailing null fields
- return if (length(@kplist) < 1); # Also empty
- shift(@kplist) if ($kplist[0] eq ""); # First can be empty
- return if (length(@kplist) < 1); # Also empty
- %tempSection = split(/$FS2/, $kplist[0], -1);
- if (!defined($tempSection{'keepts'})) {
- return; # Bad keep file
- }
- $expirets = $Now - ($KeepDays * 24 * 60 * 60);
- return if ($tempSection{'keepts'} >= $expirets); # Nothing old enough
- $anyExpire = 0;
- $anyKeep = 0;
- %keepFlag = ();
- $oldMajor = &GetPageCache('oldmajor');
- $oldAuthor = &GetPageCache('oldauthor');
- foreach (reverse @kplist) {
- %tempSection = split(/$FS2/, $_, -1);
- $sectName = $tempSection{'name'};
- $sectRev = $tempSection{'revision'};
- $expire = 0;
- if ($sectName eq "text_default") {
- if (($KeepMajor && ($sectRev == $oldMajor)) ||
- ($KeepAuthor && ($sectRev == $oldAuthor))) {
- $expire = 0;
- } elsif ($tempSection{'keepts'} < $expirets) {
- $expire = 1;
- }
- } else {
- if ($tempSection{'keepts'} < $expirets) {
- $expire = 1;
- }
- }
- if (!$expire) {
- $keepFlag{$sectRev . "," . $sectName} = 1;
- $anyKeep = 1;
- } else {
- $anyExpire = 1;
- }
- }
- if (!$anyKeep) { # Empty, so remove file
- unlink($fname);
- return;
- }
- return if (!$anyExpire); # No sections expired
- open (OUT, ">$fname") or die (Ts('cant write %s', $fname) . ": $!");
- foreach (@kplist) {
- %tempSection = split(/$FS2/, $_, -1);
- $sectName = $tempSection{'name'};
- $sectRev = $tempSection{'revision'};
- if ($keepFlag{$sectRev . "," . $sectName}) {
- print OUT $FS1, $_;
- }
- }
- close(OUT);
- }
- sub OpenKeptList {
- my ($fname, $data);
- @KeptList = ();
- $fname = &KeepFileName();
- return if (!(-f $fname));
- $data = &ReadFileOrDie($fname);
- @KeptList = split(/$FS1/, $data, -1); # -1 keeps trailing null fields
- }
- sub OpenKeptRevisions {
- my ($name) = @_; # Name of section
- my ($fname, $data, %tempSection);
- %KeptRevisions = ();
- &OpenKeptList();
- foreach (@KeptList) {
- %tempSection = split(/$FS2/, $_, -1);
- next if ($tempSection{'name'} ne $name);
- $KeptRevisions{$tempSection{'revision'}} = $_;
- }
- }
- sub LoadUserData {
- my ($data, $status);
- %UserData = ();
- ($status, $data) = &ReadFile(&UserDataFilename($UserID));
- if (!$status) {
- $UserID = 112; # Could not open file. Consider warning message?
- return;
- }
- %UserData = split(/$FS1/, $data, -1); # -1 keeps trailing null fields
- }
- sub UserDataFilename {
- my ($id) = @_;
- return "" if ($id < 1);
- return $UserDir . "/" . ($id % 10) . "/$id.db";
- }
- # ==== Misc. functions ====
- sub ReportError {
- my ($errmsg) = @_;
- print $q->header, $q->start_html, "<H2>", &QuoteHtml($errmsg), "</H2>", $q->end_html;
- }
- sub ValidId {
- my ($id) = @_;
- if (length($id) > 120) {
- return Ts('Page name is too long: %s', $id);
- }
- if ($id =~ m| |) {
- return Ts('Page name may not contain space characters: %s', $id);
- }
- if ($UseSubpage) {
- if ($id =~ m|.*/.*/|) {
- return Ts('Too many / characters in page %s', $id);
- }
- if ($id =~ /^\//) {
- return Ts('Invalid Page %s (subpage without main page)', $id);
- }
- if ($id =~ /\/$/) {
- return Ts('Invalid Page %s (missing subpage name)', $id);
- }
- }
- if ($FreeLinks) {
- $id =~ s/ /_/g;
- if (!$UseSubpage) {
- if ($id =~ /\//) {
- return Ts('Invalid Page %s (/ not allowed)', $id);
- }
- }
- if (!($id =~ m|^$FreeLinkPattern$|)) {
- return Ts('Invalid Page %s', $id);
- }
- if ($id =~ m|\.db$|) {
- return Ts('Invalid Page %s (must not end with .db)', $id);
- }
- if ($id =~ m|\.lck$|) {
- return Ts('Invalid Page %s (must not end with .lck)', $id);
- }
- return "";
- } else {
- if (!($id =~ /^$LinkPattern$/)) {
- return Ts('Invalid Page %s', $id);
- }
- }
- return "";
- }
- sub ValidIdOrDie {
- my ($id) = @_;
- my $error;
- $error = &ValidId($id);
- if ($error ne "") {
- &ReportError($error);
- return 0;
- }
- return 1;
- }
- sub UserCanEdit {
- my ($id, $deepCheck) = @_;
- # Optimized for the "everyone can edit" case (don't check passwords)
- if (($id ne "") && (-f &GetLockedPageFile($id))) {
- return 1 if (&UserIsAdmin()); # Requires more privledges
- # Consider option for editor-level to edit these pages?
- return 0;
- }
- if (!$EditAllowed) {
- return 1 if (&UserIsEditor());
- return 0;
- }
- if (-f "$DataDir/noedit") {
- return 1 if (&UserIsEditor());
- return 0;
- }
- if ($deepCheck) { # Deeper but slower checks (not every page)
- return 1 if (&UserIsEditor());
- return 0 if (&UserIsBanned());
- }
- return 1;
- }
- sub UserIsBanned {
- my ($host, $ip, $data, $status);
- ($status, $data) = &ReadFile("$DataDir/banlist");
- return 0 if (!$status); # No file exists, so no ban
- $data =~ s/\r//g;
- $ip = $ENV{'REMOTE_ADDR'};
- $host = &GetRemoteHost(0);
- foreach (split(/\n/, $data)) {
- next if ((/^\s*$/) || (/^#/)); # Skip empty, spaces, or comments
- return 1 if ($ip =~ /$_/i);
- return 1 if ($host =~ /$_/i);
- }
- return 0;
- }
- sub UserIsAdmin {
- my (@pwlist, $userPassword);
- return 0 if ($AdminPass eq "");
- $userPassword = &GetParam("adminpw", "");
- return 0 if ($userPassword eq "");
- foreach (split(/\s+/, $AdminPass)) {
- next if ($_ eq "");
- return 1 if ($userPassword eq $_);
- }
- return 0;
- }
- sub UserIsEditor {
- my (@pwlist, $userPassword);
- return 1 if (&UserIsAdmin()); # Admin includes editor
- return 0 if ($EditPass eq "");
- $userPassword = &GetParam("adminpw", ""); # Used for both
- return 0 if ($userPassword eq "");
- foreach (split(/\s+/, $EditPass)) {
- next if ($_ eq "");
- return 1 if ($userPassword eq $_);
- }
- return 0;
- }
- sub UserCanUpload {
- return 1 if (&UserIsEditor());
- return $AllUpload;
- }
- sub GetLockedPageFile {
- my ($id) = @_;
- return $PageDir . "/" . &GetPageDirectory($id) . "/$id.lck";
- }
- sub RequestLockDir {
- my ($name, $tries, $wait, $errorDie) = @_;
- my ($lockName, $n);
- &CreateDir($TempDir);
- $lockName = $LockDir . $name;
- $n = 0;
- while (mkdir($lockName, 0555) == 0) {
- if ($! != 17) {
- die(Ts('can not make %s', $LockDir) . ": $!\n") if $errorDie;
- return 0;
- }
- return 0 if ($n++ >= $tries);
- sleep($wait);
- }
- return 1;
- }
- sub ReleaseLockDir {
- my ($name) = @_;
- rmdir($LockDir . $name);
- }
- sub RequestLock {
- # 10 tries, 3 second wait, possibly die on error
- return &RequestLockDir("main", 10, 3, $LockCrash);
- }
- sub ReleaseLock {
- &ReleaseLockDir('main');
- }
- sub ForceReleaseLock {
- my ($name) = @_;
- my $forced;
- # First try to obtain lock (in case of normal edit lock)
- # 5 tries, 3 second wait, do not die on error
- $forced = !&RequestLockDir($name, 5, 3, 0);
- &ReleaseLockDir($name); # Release the lock, even if we didn't get it.
- return $forced;
- }
- sub RequestCacheLock {
- # 4 tries, 2 second wait, do not die on error
- return &RequestLockDir('cache', 4, 2, 0);
- }
- sub ReleaseCacheLock {
- &ReleaseLockDir('cache');
- }
- sub RequestDiffLock {
- # 4 tries, 2 second wait, do not die on error
- return &RequestLockDir('diff', 4, 2, 0);
- }
- sub ReleaseDiffLock {
- &ReleaseLockDir('diff');
- }
- # Index lock is not very important--just return error if not available
- sub RequestIndexLock {
- # 1 try, 2 second wait, do not die on error
- return &RequestLockDir('index', 1, 2, 0);
- }
- sub ReleaseIndexLock {
- &ReleaseLockDir('index');
- }
- sub ReadFile {
- my ($fileName) = @_;
- my ($data);
- local $/ = undef; # Read complete files
- if (open(IN, "<$fileName")) {
- $data=<IN>;
- close IN;
- return (1, $data);
- }
- return (0, "");
- }
- sub ReadFileOrDie {
- my ($fileName) = @_;
- my ($status, $data);
- ($status, $data) = &ReadFile($fileName);
- if (!$status) {
- die(Ts('Can not open %s', $fileName) . ": $!");
- }
- return $data;
- }
- sub WriteStringToFile {
- my ($file, $string) = @_;
- open (OUT, ">$file") or die(Ts('cant write %s', $file) . ": $!");
- print OUT $string;
- close(OUT);
- }
- sub AppendStringToFile {
- my ($file, $string) = @_;
- open (OUT, ">>$file") or die(Ts('cant write %s', $file) . ": $!");
- print OUT $string;
- close(OUT);
- }
- sub AppendStringToFileLimited {
- my ($file, $string, $limit) = @_;
- if (($limit < 1) || (((-s $file) + length($string)) <= $limit)) {
- &AppendStringToFile($file, $string);
- }
- }
- sub CreateDir {
- my ($newdir) = @_;
- mkdir($newdir, 0775) if (!(-d $newdir));
- }
- sub CreatePageDir {
- my ($dir, $id) = @_;
- my $subdir;
- &CreateDir($dir); # Make sure main page exists
- $subdir = $dir . "/" . &GetPageDirectory($id);
- &CreateDir($subdir);
- if ($id =~ m|([^/]+)/|) {
- $subdir = $subdir . "/" . $1;
- &CreateDir($subdir);
- }
- }
- sub UpdateHtmlCache {
- my ($id, $html) = @_;
- my $idFile;
- $idFile = &GetHtmlCacheFile($id);
- &CreatePageDir($HtmlDir, $id);
- if (&RequestCacheLock()) {
- &WriteStringToFile($idFile, $html);
- &ReleaseCacheLock();
- }
- }
- sub GenerateAllPagesList {
- my (@pages, @dirs, $id, $dir, @pageFiles, @subpageFiles, $subId);
- @pages = ();
- if ($FastGlob) {
- # The following was inspired by the FastGlob code by Marc W. Mengel.
- # Thanks to Bob Showalter for pointing out the improvement.
- opendir(PAGELIST, $PageDir);
- @dirs = readdir(PAGELIST);
- closedir(PAGELIST);
- @dirs = sort(@dirs);
- foreach $dir (@dirs) {
- next if (substr($dir, 0, 1) eq '.'); # No ., .., or .dirs or files
- opendir(PAGELIST, "$PageDir/$dir");
- @pageFiles = readdir(PAGELIST);
- closedir(PAGELIST);
- foreach $id (@pageFiles) {
- next if (($id eq '.') || ($id eq '..'));
- if (substr($id, -3) eq '.db') {
- push(@pages, substr($id, 0, -3));
- } elsif (substr($id, -4) ne '.lck') {
- opendir(PAGELIST, "$PageDir/$dir/$id");
- @subpageFiles = readdir(PAGELIST);
- closedir(PAGELIST);
- foreach $subId (@subpageFiles) {
- if (substr($subId, -3) eq '.db') {
- push(@pages, "$id/" . substr($subId, 0, -3));
- }
- }
- }
- }
- }
- } else {
- # Old slow/compatible method.
- @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);
- foreach $dir (@dirs) {
- if (-e "$PageDir/$dir") { # Thanks to Tim Holt
- while (<$PageDir/$dir/*.db $PageDir/$dir/*/*.db>) {
- s|^$PageDir/||;
- m|^[^/]+/(\S*).db|;
- $id = $1;
- push(@pages, $id);
- }
- }
- }
- }
- return sort(@pages);
- }
- sub AllPagesList {
- my ($rawIndex, $refresh, $status);
- if (!$UseIndex) {
- return &GenerateAllPagesList();
- }
- $refresh = &GetParam("refresh", 0);
- if ($IndexInit && !$refresh) {
- # Note for mod_perl: $IndexInit is reset for each query
- # Eventually consider some timestamp-solution to keep cache?
- return @IndexList;
- }
- if ((!$refresh) && (-f $IndexFile)) {
- ($status, $rawIndex) = &ReadFile($IndexFile);
- if ($status) {
- %IndexHash = split(/\s+/, $rawIndex);
- @IndexList = sort(keys %IndexHash);
- $IndexInit = 1;
- return @IndexList;
- }
- # If open fails just refresh the index
- }
- @IndexList = ();
- %IndexHash = ();
- @IndexList = &GenerateAllPagesList();
- foreach (@IndexList) {
- $IndexHash{$_} = 1;
- }
- $IndexInit = 1; # Initialized for this run of the script
- # Try to write out the list for future runs
- &RequestIndexLock() or return @IndexList;
- &WriteStringToFile($IndexFile, join(" ", %IndexHash));
- &ReleaseIndexLock();
- return @IndexList;
- }
- sub CalcDay {
- my ($ts) = @_;
- $ts += $TimeZoneOffset;
- my ($sec, $min, $hour, $mday, $mon, $year) = localtime($ts);
- if ($NumberDates) {
- return ($year + 1900) . '-' . ($mon+1) . '-' . $mday;
- }
- return ("January", "February", "March", "April", "May", "June",
- "July", "August", "September", "October", "November",
- "December")[$mon]. " " . $mday . ", " . ($year+1900);
- }
- sub CalcTime {
- my ($ts) = @_;
- my ($ampm, $mytz);
- $ts += $TimeZoneOffset;
- my ($sec, $min, $hour, $mday, $mon, $year) = localtime($ts);
- $mytz = "";
- if (($TimeZoneOffset == 0) && ($ScriptTZ ne "")) {
- $mytz = " " . $ScriptTZ;
- }
- $ampm = "";
- if ($UseAmPm) {
- $ampm = " am";
- if ($hour > 11) {
- $ampm = " pm";
- $hour = $hour - 12;
- }
- $hour = 12 if ($hour == 0);
- }
- $min = "0" . $min if ($min<10);
- return $hour . ":" . $min . $ampm . $mytz;
- }
- sub TimeToText {
- my ($t) = @_;
- return &CalcDay($t) . " " . &CalcTime($t);
- }
- sub GetParam {
- my ($name, $default) = @_;
- my $result;
- $result = $q->param($name);
- if (!defined($result)) {
- if (defined($UserData{$name})) {
- $result = $UserData{$name};
- } else {
- $result = $default;
- }
- }
- return $result;
- }
- sub GetHiddenValue {
- my ($name, $value) = @_;
- $q->param($name, $value);
- return $q->hidden($name);
- }
- sub GetRemoteHost {
- my ($doMask) = @_;
- my ($rhost, $iaddr);
- $rhost = $ENV{REMOTE_HOST};
- if ($UseLookup && ($rhost eq "")) {
- # Catch errors (including bad input) without aborting the script
- eval 'use Socket; $iaddr = inet_aton($ENV{REMOTE_ADDR});'
- . '$rhost = gethostbyaddr($iaddr, AF_INET)';
- }
- if ($rhost eq "") {
- $rhost = $ENV{REMOTE_ADDR};
- }
- $rhost = &GetMaskedHost($rhost) if ($doMask);
- return $rhost;
- }
- sub FreeToNormal {
- my ($id) = @_;
- $id =~ s/ /_/g;
- $id = ucfirst($id) if ($UpperFirst || $FreeUpper);
- if (index($id, '_') > -1) { # Quick check for any space/underscores
- $id =~ s/__+/_/g;
- $id =~ s/^_//;
- $id =~ s/_$//;
- if ($UseSubpage) {
- $id =~ s|_/|/|g;
- $id =~ s|/_|/|g;
- }
- }
- if ($FreeUpper) {
- # Note that letters after ' are *not* capitalized
- if ($id =~ m|[-_.,\(\)/][a-z]|) { # Quick check for non-canonical case
- $id =~ s|([-_.,\(\)/])([a-z])|$1 . uc($2)|ge;
- }
- }
- return $id;
- }
- #END_OF_BROWSE_CODE
- # == Page-editing and other special-action code ========================
- $OtherCode = ""; # Comment next line to always compile (slower)
- #$OtherCode = <<'#END_OF_OTHER_CODE';
- sub DoOtherRequest {
- my ($id, $action, $text, $search);
- $action = &GetParam("action", "");
- $id = &GetParam("id", "");
- if ($action ne "") {
- $action = lc($action);
- if ($action eq "edit") {
- &DoEdit($id, 0, 0, "", 0) if &ValidIdOrDie($id);
- } elsif ($action eq "unlock") {
- &DoUnlock();
- } elsif ($action eq "index") {
- &DoIndex();
- } elsif ($action eq "links") {
- &DoLinks();
- } elsif ($action eq "maintain") {
- &DoMaintain();
- } elsif ($action eq "pagelock") {
- &DoPageLock();
- } elsif ($action eq "editlock") {
- &DoEditLock();
- } elsif ($action eq "editprefs") {
- &DoEditPrefs();
- } elsif ($action eq "editbanned") {
- &DoEditBanned();
- } elsif ($action eq "editlinks") {
- &DoEditLinks();
- } elsif ($action eq "login") {
- &DoEnterLogin();
- } elsif ($action eq "newlogin") {
- $UserID = 0;
- &DoEditPrefs(); # Also creates new ID
- } elsif ($action eq "version") {
- &DoShowVersion();
- } elsif ($action eq "rss") {
- &DoRss();
- } elsif ($action eq "delete") {
- &DoDeletePage($id);
- } elsif ($UseUpload && ($action eq "upload")) {
- &DoUpload();
- } elsif ($action eq "maintainrc") {
- &DoMaintainRc();
- } elsif ($action eq "convert") {
- &DoConvert();
- } elsif ($action eq "trimusers") {
- &DoTrimUsers();
- } else {
- &ReportError(Ts('Invalid action parameter %s', $action));
- }
- return;
- }
- if (&GetParam("edit_prefs", 0)) {
- &DoUpdatePrefs();
- return;
- }
- if (&GetParam("edit_ban", 0)) {
- &DoUpdateBanned();
- return;
- }
- if (&GetParam("enter_login", 0)) {
- &DoLogin();
- return;
- }
- if (&GetParam("edit_links", 0)) {
- &DoUpdateLinks();
- return;
- }
- if ($UseUpload && (&GetParam("upload", 0))) {
- &SaveUpload();
- return;
- }
- $search = &GetParam("search", "");
- if (($search ne "") || (&GetParam("dosearch", "") ne "")) {
- &DoSearch($search);
- return;
- } else {
- $search = &GetParam("back","");
- if ($search ne "") {
- &DoBackLinks($search);
- return;
- }
- }
- # Handle posted pages
- if (&GetParam("oldtime", "") ne "") {
- $id = &GetParam("title", "");
- &DoPost() if &ValidIdOrDie($id);
- return;
- }
- &ReportError(T('Invalid URL.'));
- }
- sub DoEdit {
- my ($id, $isConflict, $oldTime, $newText, $preview) = @_;
- my ($header, $editRows, $editCols, $userName, $revision, $oldText);
- my ($summary, $isEdit, $pageTime);
- if ($FreeLinks) {
- $id = &FreeToNormal($id); # Take care of users like Markus Lude :-)
- }
- if (!&UserCanEdit($id, 1)) {
- print &GetHeader('', T('Editing Denied'), '');
- if (&UserIsBanned()) {
- print T('Editing not allowed: user, ip, or network is blocked.');
- print "<p>";
- print T('Contact the wiki administrator for more information.');
- } else {
- print Ts('Editing not allowed: %s is read-only.', $SiteName);
- }
- print &GetCommonFooter();
- return;
- }
- # Consider sending a new user-ID cookie if user does not have one
- &OpenPage($id);
- &OpenDefaultText();
- $pageTime = $Section{'ts'};
- $header = Ts('Editing %s', $id);
- # Old revision handling
- $revision = &GetParam('revision', '');
- $revision =~ s/\D//g; # Remove non-numeric chars
- if ($revision ne '') {
- &OpenKeptRevisions('text_default');
- if (!defined($KeptRevisions{$revision})) {
- $revision = '';
- # Consider better solution like error message?
- } else {
- &OpenKeptRevision($revision);
- $header = Ts('Editing revision %s of ', $revision ) . $id;
- }
- }
- $oldText = $Text{'text'};
- if ($preview && !$isConflict) {
- $oldText = $newText;
- }
- $editRows = &GetParam("editrows", 20);
- $editCols = &GetParam("editcols", 65);
- print &GetHeader($id, &QuoteHtml($header), '');
- if ($revision ne '') {
- print "\n<b>"
- . Ts('Editing old revision %s.', $revision) . " "
- . T('Saving this page will replace the latest revision with this text.')
- . '</b><br>'
- }
- if ($isConflict) {
- $editRows -= 10 if ($editRows > 19);
- print "\n<H1>" . T('Edit Conflict!') . "</H1>\n";
- if ($isConflict>1) {
- # The main purpose of a new warning is to display more text
- # and move the save button down from its old location.
- print "\n<H2>" . T('(This is a new conflict)') . "</H2>\n";
- }
- print "<p><strong>",
- T('Someone saved this page after you started editing.'), " ",
- T('The top textbox contains the saved text.'), " ",
- T('Only the text in the top textbox will be saved.'),
- "</strong><br>\n",
- T('Scroll down to see your edited text.'), "<br>\n";
- print T('Last save time:'), ' ', &TimeToText($oldTime),
- " (", T('Current time is:'), ' ', &TimeToText($Now), ")<br>\n";
- }
- print &GetFormStart();
- print &GetHiddenValue("title", $id), "\n",
- &GetHiddenValue("oldtime", $pageTime), "\n",
- &GetHiddenValue("oldconflict", $isConflict), "\n";
- if ($revision ne "") {
- print &GetHiddenValue("revision", $revision), "\n";
- }
- print &GetTextArea('text', $oldText, $editRows, $editCols);
- $summary = &GetParam("summary", "*");
- print "<p>", T('Summary:'),
- $q->textfield(-name=>'summary',
- -default=>$summary, -override=>1,
- -size=>60, -maxlength=>200);
- if (&GetParam("recent_edit") eq "on") {
- print "<br>", $q->checkbox(-name=>'recent_edit', -checked=>1,
- -label=>T('This change is a minor edit.'));
- } else {
- print "<br>", $q->checkbox(-name=>'recent_edit',
- -label=>T('This change is a minor edit.'));
- }
- if ($EmailNotify) {
- print " " .
- $q->checkbox(-name=> 'do_email_notify',
- -label=>Ts('Send email notification that %s has been changed.', $id));
- }
- print "<br>";
- if ($EditNote ne '') {
- print T($EditNote) . '<br>'; # Allow translation
- }
- print $q->submit(-name=>'Save', -value=>T('Save')), "\n";
- $userName = &GetParam("username", "");
- if ($userName ne "") {
- print ' (', T('Your user name is'), ' ',
- &GetPageLink($userName) . ') ';
- } else {
- print ' (', Ts('Visit %s to set your user name.', &GetPrefsLink(), 1), ') ';
- }
- print $q->submit(-name=>'Preview', -value=>T('Preview')), "\n";
- if ($isConflict) {
- print "\n<br><hr><p><strong>", T('This is the text you submitted:'),
- "</strong><p>",
- &GetTextArea('newtext', $newText, $editRows, $editCols),
- "<p>\n";
- }
- if ($preview) {
- print '<div class=wikipreview>';
- print "<hr class=wikilinepreview>\n";
- print "<h2>", T('Preview:'), "</h2>\n";
- if ($isConflict) {
- print "<b>",
- T('NOTE: This preview shows the revision of the other author.'),
- "</b><hr>\n";
- }
- $MainPage = $id;
- $MainPage =~ s|/.*||; # Only the main page name (remove subpage)
- print &WikiToHTML($oldText) . "<hr class=wikilinepreview>\n";
- print "<h2>", T('Preview only, not yet saved'), "</h2>\n";
- print '</div>';
- }
- print $q->endform;
- if (!&GetParam('embed', $EmbedWiki)) {
- print '<div class=wikifooter>';
- print "<hr class=wikilinefooter>\n";
- print &GetHistoryLink($id, T('View other revisions')) . "<br>\n";
- print &GetGotoBar($id);
- print '</div>';
- }
- print &GetMinimumFooter();
- }
- sub GetTextArea {
- my ($name, $text, $rows, $cols) = @_;
- if (&GetParam("editwide", 1)) {
- return $q->textarea(-name=>$name, -default=>$text,
- -rows=>$rows, -columns=>$cols, -override=>1,
- -style=>'width:100%', -wrap=>'virtual');
- }
- return $q->textarea(-name=>$name, -default=>$text,
- -rows=>$rows, -columns=>$cols, -override=>1,
- -wrap=>'virtual');
- }
- sub DoEditPrefs {
- my ($check, $recentName, %labels);
- $recentName = $RCName;
- $recentName =~ s/_/ /g;
- &DoNewLogin() if ($UserID < 400);
- print &GetHeader('', T('Editing Preferences'), '');
- print '<div class=wikipref>';
- print &GetFormStart();
- print GetHiddenValue("edit_prefs", 1), "\n";
- print '<b>' . T('User Information:') . "</b>\n";
- print '<br>' . Ts('Your User ID number: %s', $UserID) . "\n";
- print '<br>' . T('UserName:') . ' ', &GetFormText('username', "", 20, 50);
- print ' ' . T('(blank to remove, or valid page name)');
- print '<br>' . T('Set Password:') . ' ',
- $q->password_field(-name=>'p_password', -value=>'*',
- -size=>15, -maxlength=>50),
- ' ', T('(blank to remove password)'), '<br>(',
- T('Passwords allow sharing preferences between multiple systems.'),
- ' ', T('Passwords are completely optional.'), ')';
- if (($AdminPass ne '') || ($EditPass ne '')) {
- print '<br>', T('Administrator Password:'), ' ',
- $q->password_field(-name=>'p_adminpw', -value=>'*',
- -size=>15, -maxlength=>50),
- ' ', T('(blank to remove password)'), '<br>',
- T('(Administrator passwords are used for special maintenance.)');
- }
- if ($EmailNotify) {
- print "<br>";
- print &GetFormCheck('notify', 1,
- T('Include this address in the site email list.')), ' ',
- T('(Uncheck the box to remove the address.)');
- print '<br>', T('Email Address:'), ' ',
- &GetFormText('email', "", 30, 60);
- }
- print "<hr class=wikilinepref><b>$recentName:</b>\n";
- print '<br>', T('Default days to display:'), ' ',
- &GetFormText('rcdays', $RcDefault, 4, 9);
- print "<br>", &GetFormCheck('rcnewtop', $RecentTop,
- T('Most recent changes on top'));
- print "<br>", &GetFormCheck('rcall', 0,
- T('Show all changes (not just most recent)'));
- %labels = (0=>T('Hide minor edits'), 1=>T('Show minor edits'),
- 2=>T('Show only minor edits'));
- print '<br>', T('Minor edit display:'), ' ';
- print $q->popup_menu(-name=>'p_rcshowedit',
- -values=>[0,1,2], -labels=>\%labels,
- -default=>&GetParam("rcshowedit", $ShowEdits));
- print "<br>", &GetFormCheck('rcchangehist', 1,
- T('Use "changes" as link to history'));
- if ($UseDiff) {
- print '<hr class=wikilinepref><b>', T('Differences:'), "</b>\n";
- print "<br>", &GetFormCheck('diffrclink', 1,
- Ts('Show (diff) links on %s', $recentName));
- print "<br>", &GetFormCheck('alldiff', 0,
- T('Show differences on all pages'));
- print " (", &GetFormCheck('norcdiff', 1,
- Ts('No differences on %s', $recentName)), ")";
- %labels = (1=>T('Major'), 2=>T('Minor'), 3=>T('Author'));
- print '<br>', T('Default difference type:'), ' ';
- print $q->popup_menu(-name=>'p_defaultdiff',
- -values=>[1,2,3], -labels=>\%labels,
- -default=>&GetParam("defaultdiff", 1));
- }
- print '<hr class=wikilinepref><b>', T('Misc:'), "</b>\n";
- # Note: TZ offset is added by TimeToText, so pre-subtract to cancel.
- print '<br>', T('Server time:'), ' ', &TimeToText($Now-$TimeZoneOffset);
- print '<br>', T('Time Zone offset (hours):'), ' ',
- &GetFormText('tzoffset', 0, 4, 9);
- print '<br>', &GetFormCheck('editwide', 1,
- T('Use 100% wide edit area (if supported)'));
- print '<br>',
- T('Edit area rows:'), ' ', &GetFormText('editrows', 20, 4, 4),
- ' ', T('columns:'), ' ', &GetFormText('editcols', 65, 4, 4);
- print '<br>', &GetFormCheck('toplinkbar', 1,
- T('Show link bar on top'));
- print '<br>', &GetFormCheck('linkrandom', 0,
- T('Add "Random Page" link to link bar'));
- print '<br>' . T('StyleSheet URL:') . ' ',
- &GetFormText('stylesheet', "", 30, 150);
- print '<br>', $q->submit(-name=>'Save', -value=>T('Save')), "\n";
- print $q->endform;
- print '</div>';
- if (!&GetParam('embed', $EmbedWiki)) {
- print '<div class=wikifooter>';
- print "<hr class=wikilinefooter>\n";
- print &GetGotoBar('');
- print '</div>';
- }
- print &GetMinimumFooter();
- }
- sub GetFormText {
- my ($name, $default, $size, $max) = @_;
- my $text = &GetParam($name, $default);
- return $q->textfield(-name=>"p_$name", -default=>$text,
- -override=>1, -size=>$size, -maxlength=>$max);
- }
- sub GetFormCheck {
- my ($name, $default, $label) = @_;
- my $checked = (&GetParam($name, $default) > 0);
- return $q->checkbox(-name=>"p_$name", -override=>1, -checked=>$checked,
- -label=>$label);
- }
- sub DoUpdatePrefs {
- my ($username, $password, $stylesheet);
- # All link bar settings should be updated before printing the header
- &UpdatePrefCheckbox("toplinkbar");
- &UpdatePrefCheckbox("linkrandom");
- print &GetHeader('', T('Saving Preferences'), '');
- print '<br>';
- if ($UserID < 1001) {
- print '<b>',
- Ts('Invalid UserID %s, preferences not saved.', $UserID), '</b>';
- if ($UserID == 111) {
- print '<br>',
- T('(Preferences require cookies, but no cookie was sent.)');
- }
- print &GetCommonFooter();
- return;
- }
- $username = &GetParam("p_username", "");
- if ($FreeLinks) {
- $username =~ s/^\[\[(.+)\]\]/$1/; # Remove [[ and ]] if added
- $username = &FreeToNormal($username);
- $username =~ s/_/ /g;
- }
- if ($username eq "") {
- print T('UserName removed.'), '<br>';
- undef $UserData{'username'};
- } elsif ((!$FreeLinks) && (!($username =~ /^$LinkPattern$/))) {
- print Ts('Invalid UserName %s: not saved.', $username), "<br>\n";
- } elsif ($FreeLinks && (!($username =~ /^$FreeLinkPattern$/))) {
- print Ts('Invalid UserName %s: not saved.', $username), "<br>\n";
- } elsif (length($username) > 50) { # Too long
- print T('UserName must be 50 characters or less. (not saved)'), "<br>\n";
- } else {
- print Ts('UserName %s saved.', $username), '<br>';
- $UserData{'username'} = $username;
- }
- $password = &GetParam("p_password", "");
- if ($password eq "") {
- print T('Password removed.'), '<br>';
- undef $UserData{'password'};
- } elsif ($password ne "*") {
- print T('Password changed.'), '<br>';
- $UserData{'password'} = $password;
- }
- if (($AdminPass ne "") || ($EditPass ne "")) {
- $password = &GetParam("p_adminpw", "");
- if ($password eq "") {
- print T('Administrator password removed.'), '<br>';
- undef $UserData{'adminpw'};
- } elsif ($password ne "*") {
- print T('Administrator password changed.'), '<br>';
- $UserData{'adminpw'} = $password;
- if (&UserIsAdmin()) {
- print T('User has administrative abilities.'), '<br>';
- } elsif (&UserIsEditor()) {
- print T('User has editor abilities.'), '<br>';
- } else {
- print T('User does not have administrative abilities.'), ' ',
- T('(Password does not match administrative password(s).)'),
- '<br>';
- }
- }
- }
- if ($EmailNotify) {
- &UpdatePrefCheckbox("notify");
- &UpdateEmailList();
- }
- &UpdatePrefNumber("rcdays", 0, 0, 999999);
- &UpdatePrefCheckbox("rcnewtop");
- &UpdatePrefCheckbox("rcall");
- &UpdatePrefCheckbox("rcchangehist");
- &UpdatePrefCheckbox("editwide");
- if ($UseDiff) {
- &UpdatePrefCheckbox("norcdiff");
- &UpdatePrefCheckbox("diffrclink");
- &UpdatePrefCheckbox("alldiff");
- &UpdatePrefNumber("defaultdiff", 1, 1, 3);
- }
- &UpdatePrefNumber("rcshowedit", 1, 0, 2);
- &UpdatePrefNumber("tzoffset", 0, -999, 999);
- &UpdatePrefNumber("editrows", 1, 1, 999);
- &UpdatePrefNumber("editcols", 1, 1, 999);
- print T('Server time:'), ' ', &TimeToText($Now-$TimeZoneOffset), '<br>';
- $TimeZoneOffset = &GetParam("tzoffset", 0) * (60 * 60);
- print T('Local time:'), ' ', &TimeToText($Now), '<br>';
- $stylesheet = &GetParam('p_stylesheet', '');
- if ($stylesheet eq '') {
- if (&GetParam('stylesheet', '') ne '') {
- print T('StyleSheet URL removed.'), '<br>';
- }
- undef $UserData{'stylesheet'};
- } else {
- $stylesheet =~ s/[">]//g; # Remove characters that would cause problems
- $UserData{'stylesheet'} = $stylesheet;
- print T('StyleSheet setting saved.'), '<br>';
- }
- &SaveUserData();
- print '<b>', T('Preferences saved.'), '</b>';
- print &GetCommonFooter();
- }
- # add or remove email address from preferences to $EmailFile
- sub UpdateEmailList {
- my (@old_emails);
- local $/ = "\n"; # don't slurp whole files in this sub.
- if (my $new_email = $UserData{'email'} = &GetParam("p_email", "")) {
- my $notify = $UserData{'notify'};
- if (-f $EmailFile) {
- open(NOTIFY, $EmailFile)
- or die(Ts('Could not read from %s:', $EmailFile) . " $!\n");
- @old_emails = <NOTIFY>;
- close(NOTIFY);
- } else {
- @old_emails = ();
- }
- my $already_in_list = grep /$new_email/, @old_emails;
- if ($notify and (not $already_in_list)) {
- &RequestLock() or die(T('Could not get mail lock'));
- if (!open(NOTIFY, ">>$EmailFile")) {
- &ReleaseLock(); # Don't leave hangling locks
- die(Ts('Could not append to %s:', $EmailFile) . " $!\n");
- }
- print NOTIFY $new_email, "\n";
- close(NOTIFY);
- &ReleaseLock();
- }
- elsif ((not $notify) and $already_in_list) {
- &RequestLock() or die(T('Could not get mail lock'));
- if (!open(NOTIFY, ">$EmailFile")) {
- &ReleaseLock();
- die(Ts('Could not overwrite %s:', "$EmailFile") . " $!\n");
- }
- foreach (@old_emails) {
- print NOTIFY "$_" unless /$new_email/;
- }
- close(NOTIFY);
- &ReleaseLock();
- }
- }
- }
- sub UpdatePrefCheckbox {
- my ($param) = @_;
- my $temp = &GetParam("p_$param", "*");
- $UserData{$param} = 1 if ($temp eq "on");
- $UserData{$param} = 0 if ($temp eq "*");
- # It is possible to skip updating by using another value, like "2"
- }
- sub UpdatePrefNumber {
- my ($param, $integer, $min, $max) = @_;
- my $temp = &GetParam("p_$param", "*");
- return if ($temp eq "*");
- $temp =~ s/[^-\d\.]//g;
- $temp =~ s/\..*// if ($integer);
- return if ($temp eq "");
- return if (($temp < $min) || ($temp > $max));
- $UserData{$param} = $temp;
- }
- sub DoIndex {
- print &GetHeader('', T('Index of all pages'), '');
- print '<br>';
- &PrintPageList(&AllPagesList());
- print &GetCommonFooter();
- }
- # Create a new user file/cookie pair
- sub DoNewLogin {
- # Consider warning if cookie already exists
- # (maybe use "replace=1" parameter)
- &CreateUserDir();
- $SetCookie{'id'} = &GetNewUserId();
- $SetCookie{'randkey'} = int(rand(1000000000));
- $SetCookie{'rev'} = 1;
- %UserCookie = %SetCookie;
- $UserID = $SetCookie{'id'};
- # The cookie will be transmitted in the next header
- %UserData = %UserCookie;
- $UserData{'createtime'} = $Now;
- $UserData{'createip'} = $ENV{REMOTE_ADDR};
- &SaveUserData();
- }
- sub DoEnterLogin {
- print &GetHeader('', T('Login'), "");
- print &GetFormStart();
- print &GetHiddenValue('enter_login', 1), "\n";
- print '<br>', T('User ID number:'), ' ',
- $q->textfield(-name=>'p_userid', -value=>'',
- -size=>15, -maxlength=>50);
- print '<br>', T('Password:'), ' ',
- $q->password_field(-name=>'p_password', -value=>'',
- -size=>15, -maxlength=>50);
- print '<br>', $q->submit(-name=>'Login', -value=>T('Login')), "\n";
- print $q->endform;
- if (!&GetParam('embed', $EmbedWiki)) {
- print '<div class=wikifooter>';
- print "<hr class=wikilinefooter>\n";
- print &GetGotoBar('');
- print '</div>';
- }
- print &GetMinimumFooter();
- }
- sub DoLogin {
- my ($uid, $password, $success);
- $success = 0;
- $uid = &GetParam("p_userid", "");
- $uid =~ s/\D//g;
- $password = &GetParam("p_password", "");
- if (($uid > 199) && ($password ne "") && ($password ne "*")) {
- $UserID = $uid;
- &LoadUserData();
- if ($UserID > 199) {
- if (defined($UserData{'password'}) &&
- ($UserData{'password'} eq $password)) {
- $SetCookie{'id'} = $uid;
- $SetCookie{'randkey'} = $UserData{'randkey'};
- $SetCookie{'rev'} = 1;
- $success = 1;
- }
- }
- }
- print &GetHeader('', T('Login Results'), '');
- if ($success) {
- print Ts('Login for user ID %s complete.', $uid);
- } else {
- print Ts('Login for user ID %s failed.', $uid);
- }
- if (!&GetParam('embed', $EmbedWiki)) {
- print '<div class=wikifooter>';
- print "<hr class=wikilinefooter>\n";
- print &GetGotoBar('');
- print '</div>';
- }
- print &GetMinimumFooter();
- }
- sub GetNewUserId {
- my ($id);
- $id = $StartUID;
- while (-f &UserDataFilename($id+1000)) {
- $id += 1000;
- }
- while (-f &UserDataFilename($id+100)) {
- $id += 100;
- }
- while (-f &UserDataFilename($id+10)) {
- $id += 10;
- }
- &RequestLock() or die(T('Could not get user-ID lock'));
- while (-f &UserDataFilename($id)) {
- $id++;
- }
- &WriteStringToFile(&UserDataFilename($id), "lock"); # reserve the ID
- &ReleaseLock();
- return $id;
- }
- # Consider user-level lock?
- sub SaveUserData {
- my ($userFile, $data);
- &CreateUserDir();
- $userFile = &UserDataFilename($UserID);
- $data = join($FS1, %UserData);
- &WriteStringToFile($userFile, $data);
- }
- sub CreateUserDir {
- my ($n, $subdir);
- if (!(-d "$UserDir/0")) {
- &CreateDir($UserDir);
- foreach $n (0..9) {
- $subdir = "$UserDir/$n";
- &CreateDir($subdir);
- }
- }
- }
- sub DoSearch {
- my ($string) = @_;
- if ($string eq '') {
- &DoIndex();
- return;
- }
- print &GetHeader('', &QuoteHtml(Ts('Search for: %s', $string)), '');
- print '<br>';
- &PrintPageList(&SearchTitleAndBody($string));
- print &GetCommonFooter();
- }
- sub DoBackLinks {
- my ($string) = @_;
- print &GetHeader('', &QuoteHtml(Ts('Backlinks for: %s', $string)), '');
- print '<br>';
- # At this time the backlinks are mostly a renamed search.
- # An initial attempt to match links only failed on subpages and free links.
- # Escape some possibly problematic characters:
- $string =~ s/([-'().,])/\\$1/g;
- &PrintPageList(&SearchTitleAndBody($string));
- print &GetCommonFooter();
- }
- sub PrintPageList {
- my $pagename;
- print "<h2>", Ts('%s pages found:', ($#_ + 1)), "</h2>\n";
- foreach $pagename (@_) {
- print ".... " if ($pagename =~ m|/|);
- print &GetPageLink($pagename), "<br>\n";
- }
- }
- sub DoLinks {
- print &GetHeader('', &QuoteHtml(T('Full Link List')), '');
- print "<hr><pre>\n\n\n\n\n"; # Extra lines to get below the logo
- &PrintLinkList(&GetFullLinkList());
- print "</pre>\n";
- print &GetCommonFooter();
- }
- sub PrintLinkList {
- my ($pagelines, $page, $names, $editlink);
- my ($link, $extra, @links, %pgExists);
- %pgExists = ();
- foreach $page (&AllPagesList()) {
- $pgExists{$page} = 1;
- }
- $names = &GetParam("names", 1);
- $editlink = &GetParam("editlink", 0);
- foreach $pagelines (@_) {
- @links = ();
- foreach $page (split(' ', $pagelines)) {
- if ($page =~ /\:/) { # URL or InterWiki form
- if ($page =~ /$UrlPattern/) {
- ($link, $extra) = &UrlLink($page, 0); # No images
- } else {
- ($link, $extra) = &InterPageLink($page, 0); # No images
- }
- } else {
- if ($pgExists{$page}) {
- $link = &GetPageLink($page);
- } else {
- $link = $page;
- if ($editlink) {
- $link .= &GetEditLink($page, "?");
- }
- }
- }
- push(@links, $link);
- }
- if (!$names) {
- shift(@links);
- }
- print join(' ', @links), "\n";
- }
- }
- sub GetFullLinkList {
- my ($name, $unique, $sort, $exists, $empty, $link, $search);
- my ($pagelink, $interlink, $urllink);
- my (@found, @links, @newlinks, @pglist, %pgExists, %seen, $main);
- $unique = &GetParam("unique", 1);
- $sort = &GetParam("sort", 1);
- $pagelink = &GetParam("page", 1);
- $interlink = &GetParam("inter", 0);
- $urllink = &GetParam("url", 0);
- $exists = &GetParam("exists", 2);
- $empty = &GetParam("empty", 0);
- $search = &GetParam("search", "");
- if (($interlink == 2) || ($urllink == 2)) {
- $pagelink = 0;
- }
- %pgExists = ();
- @pglist = &AllPagesList();
- foreach $name (@pglist) {
- $pgExists{$name} = 1;
- }
- %seen = ();
- foreach $name (@pglist) {
- @newlinks = ();
- if ($unique != 2) {
- %seen = ();
- }
- @links = &GetPageLinks($name, $pagelink, $interlink, $urllink);
- if ($UseSubpage) {
- $main = $name;
- $main =~ s/\/.*//;
- }
- foreach $link (@links) {
- if ($UseSubpage && ($link =~ /^\//)) {
- $link = $main . $link;
- }
- $seen{$link}++;
- if (($unique > 0) && ($seen{$link} != 1)) {
- next;
- }
- if (($exists == 0) && ($pgExists{$link} == 1)) {
- next;
- }
- if (($exists == 1) && ($pgExists{$link} != 1)) {
- next;
- }
- if (($search ne "") && !($link =~ /$search/)) {
- next;
- }
- push(@newlinks, $link);
- }
- @links = @newlinks;
- if ($sort) {
- @links = sort(@links);
- }
- unshift (@links, $name);
- if ($empty || ($#links > 0)) { # If only one item, list is empty.
- push(@found, join(' ', @links));
- }
- }
- return @found;
- }
- sub GetPageLinks {
- my ($name, $pagelink, $interlink, $urllink) = @_;
- my ($text, @links);
- @links = ();
- &OpenPage($name);
- &OpenDefaultText();
- $text = $Text{'text'};
- $text =~ s/<html>((.|\n)*?)<\/html>/ /ig;
- $text =~ s/<nowiki>(.|\n)*?\<\/nowiki>/ /ig;
- $text =~ s/<pre>(.|\n)*?\<\/pre>/ /ig;
- $text =~ s/<code>(.|\n)*?\<\/code>/ /ig;
- if ($interlink) {
- $text =~ s/''+/ /g; # Quotes can adjacent to inter-site links
- $text =~ s/$InterLinkPattern/push(@links, &StripUrlPunct($1)), ' '/ge;
- } else {
- $text =~ s/$InterLinkPattern/ /g;
- }
- if ($urllink) {
- $text =~ s/''+/ /g; # Quotes can adjacent to URLs
- $text =~ s/$UrlPattern/push(@links, &StripUrlPunct($1)), ' '/ge;
- } else {
- $text =~ s/$UrlPattern/ /g;
- }
- if ($pagelink) {
- if ($FreeLinks) {
- my $fl = $FreeLinkPattern;
- $text =~ s/\[\[$fl\|[^\]]+\]\]/push(@links, &FreeToNormal($1)), ' '/ge;
- $text =~ s/\[\[$fl\]\]/push(@links, &FreeToNormal($1)), ' '/ge;
- }
- if ($WikiLinks) {
- $text =~ s/$LinkPattern/push(@links, &StripUrlPunct($1)), ' '/ge;
- }
- }
- return @links;
- }
- sub DoPost {
- my ($editDiff, $old, $newAuthor, $pgtime, $oldrev, $preview, $user);
- my $string = &GetParam("text", undef);
- my $id = &GetParam("title", "");
- my $summary = &GetParam("summary", "");
- my $oldtime = &GetParam("oldtime", "");
- my $oldconflict = &GetParam("oldconflict", "");
- my $isEdit = 0;
- my $editTime = $Now;
- my $authorAddr = $ENV{REMOTE_ADDR};
- if ($FreeLinks) {
- $id = &FreeToNormal($id);
- }
- if (!&UserCanEdit($id, 1)) {
- # This is an internal interface--we don't need to explain
- &ReportError(Ts('Editing not allowed for %s.', $id));
- return;
- }
- if (($id eq 'SampleUndefinedPage') ||
- ($id eq T('SampleUndefinedPage')) ||
- ($id eq 'Sample_Undefined_Page') ||
- ($id eq T('Sample_Undefined_Page'))) {
- &ReportError(Ts('%s cannot be defined.', $id));
- return;
- }
- $string = &RemoveFS($string);
- $summary = &RemoveFS($summary);
- $summary =~ s/[\r\n]//g;
- if (length($summary) > 300) { # Too long (longer than form allows)
- $summary = substr($summary, 0, 300);
- }
- # Add a newline to the end of the string (if it doesn't have one)
- $string .= "\n" if (!($string =~ /\n$/));
- # Lock before getting old page to prevent races
- # Consider extracting lock section into sub, and eval-wrap it?
- # (A few called routines can die, leaving locks.)
- if ($LockCrash) {
- &RequestLock() or die(T('Could not get editing lock'));
- } else {
- if (!&RequestLock()) {
- &ForceReleaseLock('main');
- }
- # Clear all other locks.
- &ForceReleaseLock('cache');
- &ForceReleaseLock('diff');
- &ForceReleaseLock('index');
- }
- &OpenPage($id);
- &OpenDefaultText();
- $old = $Text{'text'};
- $oldrev = $Section{'revision'};
- $pgtime = $Section{'ts'};
- $preview = 0;
- $preview = 1 if (&GetParam("Preview", "") ne "");
- if (!$preview && ($old eq $string)) { # No changes (ok for preview)
- &ReleaseLock();
- &ReBrowsePage($id, "", 1);
- return;
- }
- if (($UserID > 399) || ($Section{'id'} > 399)) {
- $newAuthor = ($UserID ne $Section{'id'}); # known user(s)
- } else {
- $newAuthor = ($Section{'ip'} ne $authorAddr); # hostname fallback
- }
- $newAuthor = 1 if ($oldrev == 0); # New page
- $newAuthor = 0 if (!$newAuthor); # Standard flag form, not empty
- # Detect editing conflicts and resubmit edit
- if (($oldrev > 0) && ($newAuthor && ($oldtime != $pgtime))) {
- &ReleaseLock();
- if ($oldconflict > 0) { # Conflict again...
- &DoEdit($id, 2, $pgtime, $string, $preview);
- } else {
- &DoEdit($id, 1, $pgtime, $string, $preview);
- }
- return;
- }
- if ($preview) {
- &ReleaseLock();
- &DoEdit($id, 0, $pgtime, $string, 1);
- return;
- }
- $user = &GetParam("username", "");
- # If the person doing editing chooses, send out email notification
- if ($EmailNotify) {
- &EmailNotify($id, $user) if &GetParam("do_email_notify", "") eq 'on';
- }
- if (&GetParam("recent_edit", "") eq 'on') {
- $isEdit = 1;
- }
- if (!$isEdit) {
- &SetPageCache('oldmajor', $Section{'revision'});
- }
- if ($newAuthor) {
- &SetPageCache('oldauthor', $Section{'revision'});
- }
- &SaveKeepSection();
- &ExpireKeepFile();
- if ($UseDiff) {
- &UpdateDiffs($id, $editTime, $old, $string, $isEdit, $newAuthor);
- }
- $Text{'text'} = $string;
- $Text{'minor'} = $isEdit;
- $Text{'newauthor'} = $newAuthor;
- $Text{'summary'} = $summary;
- $Section{'host'} = &GetRemoteHost(1);
- &SaveDefaultText();
- &SavePage();
- &WriteRcLog($id, $summary, $isEdit, $editTime, $Section{'revision'},
- $user, $Section{'host'});
- if ($UseCache) {
- &UnlinkHtmlCache($id); # Old cached copy is invalid
- if ($Page{'revision'} < 2) { # If this is a new page...
- &NewPageCacheClear($id); # ...uncache pages linked to this one.
- }
- }
- if ($UseIndex && ($Page{'revision'} == 1)) {
- unlink($IndexFile); # Regenerate index on next request
- }
- &ReleaseLock();
- &ReBrowsePage($id, "", 1);
- }
- sub UpdateDiffs {
- my ($id, $editTime, $old, $new, $isEdit, $newAuthor) = @_;
- my ($editDiff, $oldMajor, $oldAuthor);
- $editDiff = &GetDiff($old, $new, 0); # 0 = already in lock
- $oldMajor = &GetPageCache('oldmajor');
- $oldAuthor = &GetPageCache('oldauthor');
- if ($UseDiffLog) {
- &WriteDiff($id, $editTime, $editDiff);
- }
- &SetPageCache('diff_default_minor', $editDiff);
- if ($isEdit || !$newAuthor) {
- &OpenKeptRevisions('text_default');
- }
- if (!$isEdit) {
- &SetPageCache('diff_default_major', "1");
- } else {
- &SetPageCache('diff_default_major', &GetKeptDiff($new, $oldMajor, 0));
- }
- if ($newAuthor) {
- &SetPageCache('diff_default_author', "1");
- } elsif ($oldMajor == $oldAuthor) {
- &SetPageCache('diff_default_author', "2");
- } else {
- &SetPageCache('diff_default_author', &GetKeptDiff($new, $oldAuthor, 0));
- }
- }
- # Translation note: the email messages are still sent in English
- # Send an email message.
- sub SendEmail {
- my ($to, $from, $reply, $subject, $message) = @_;
- # sendmail options:
- # -odq : send mail to queue (i.e. later when convenient)
- # -oi : do not wait for "." line to exit
- # -t : headers determine recipient.
- open (SENDMAIL, "| $SendMail -oi -t ") or die "Can't send email: $!\n";
- print SENDMAIL <<"EOF";
- From: $from
- To: $to
- Reply-to: $reply
- Subject: $subject\n
- $message
- EOF
- close(SENDMAIL) or warn "sendmail didn't close nicely";
- }
- ## Email folks who want to know a note that a page has been modified. - JimM.
- sub EmailNotify {
- local $/ = "\n"; # don't slurp whole files in this sub.
- if ($EmailNotify) {
- my ($id, $user) = @_;
- if ($user) {
- $user = " by $user";
- }
- my $address;
- return if (!-f $EmailFile); # No notifications yet
- open(EMAIL, $EmailFile)
- or die "Can't open $EmailFile: $!\n";
- $address = join ",", <EMAIL>;
- $address =~ s/\n//g;
- close(EMAIL);
- my $home_url = $q->url();
- my $page_url = $home_url . &ScriptLinkChar() . &UriEscape($id);
- my $pref_url = $home_url . &ScriptLinkChar() . "action=editprefs";
- my $editors_summary = $q->param("summary");
- if (($editors_summary eq "*") or ($editors_summary eq "")){
- $editors_summary = "";
- }
- else {
- $editors_summary = "\n Summary: $editors_summary";
- }
- my $content = <<"END_MAIL_CONTENT";
- The $SiteName page $id at
- $page_url
- has been changed$user to revision $Page{revision}. $editors_summary
- (Replying to this notification will
- send email to the entire mailing list,
- so only do that if you mean to.
- To remove yourself from this list, visit
- $pref_url .)
- END_MAIL_CONTENT
- my $subject = "The $id page at $SiteName has been changed.";
- # I'm setting the "reply-to" field to be the same as the "to:" field
- # which seems appropriate for a mailing list, especially since the
- # $EmailFrom string needn't be a real email address.
- &SendEmail($address, $EmailFrom, $address, $subject, $content);
- }
- }
- sub SearchTitleAndBody {
- my ($string) = @_;
- my ($name, $freeName, @found);
- foreach $name (&AllPagesList()) {
- &OpenPage($name);
- &OpenDefaultText();
- if (($Text{'text'} =~ /$string/i) || ($name =~ /$string/i)) {
- push(@found, $name);
- } elsif ($FreeLinks) {
- if ($name =~ m/_/) {
- $freeName = $name;
- $freeName =~ s/_/ /g;
- if ($freeName =~ /$string/i) {
- push(@found, $name);
- }
- } elsif ($string =~ m/ /) {
- $freeName = $string;
- $freeName =~ s/ /_/g;
- if ($Text{'text'} =~ /$freeName/i) {
- push(@found, $name);
- }
- }
- }
- }
- return @found;
- }
- sub SearchBody {
- my ($string) = @_;
- my ($name, @found);
- foreach $name (&AllPagesList()) {
- &OpenPage($name);
- &OpenDefaultText();
- if ($Text{'text'} =~ /$string/i){
- push(@found, $name);
- }
- }
- return @found;
- }
- sub UnlinkHtmlCache {
- my ($id) = @_;
- my $idFile;
- $idFile = &GetHtmlCacheFile($id);
- if (-f $idFile) {
- unlink($idFile);
- }
- }
- sub NewPageCacheClear {
- my ($id) = @_;
- my $name;
- return if (!$UseCache);
- $id =~ s|.+/|/|; # If subpage, search for just the subpage
- # The following code used to search the body for the $id
- foreach $name (&AllPagesList()) { # Remove all to be safe
- &UnlinkHtmlCache($name);
- }
- }
- # Note: all diff and recent-list operations should be done within locks.
- sub DoUnlock {
- my $LockMessage = T('Normal Unlock.');
- print &GetHeader('', T('Removing edit lock'), '');
- print '<p>', T('This operation may take several seconds...'), "\n";
- if (&ForceReleaseLock('main')) {
- $LockMessage = T('Forced Unlock.');
- }
- &ForceReleaseLock('cache');
- &ForceReleaseLock('diff');
- &ForceReleaseLock('index');
- print "<br><h2>$LockMessage</h2>";
- print &GetCommonFooter();
- }
- # Note: all diff and recent-list operations should be done within locks.
- sub WriteRcLog {
- my ($id, $summary, $isEdit, $editTime, $revision, $name, $rhost) = @_;
- my ($extraTemp, %extra);
- %extra = ();
- $extra{'id'} = $UserID if ($UserID > 0);
- $extra{'name'} = $name if ($name ne "");
- $extra{'revision'} = $revision if ($revision ne "");
- $extraTemp = join($FS2, %extra);
- # The two fields at the end of a line are kind and extension-hash
- my $rc_line = join($FS3, $editTime, $id, $summary,
- $isEdit, $rhost, "0", $extraTemp);
- if (!open(OUT, ">>$RcFile")) {
- die(Ts('%s log error:', $RCName) . " $!");
- }
- print OUT $rc_line . "\n";
- close(OUT);
- }
- sub WriteDiff {
- my ($id, $editTime, $diffString) = @_;
- open (OUT, ">>$DataDir/diff_log") or die(T('can not write diff_log'));
- print OUT "------\n" . $id . "|" . $editTime . "\n";
- print OUT $diffString;
- close(OUT);
- }
- # Actions are vetoable if someone edits the page before
- # the keep expiry time. For example, page deletion. If
- # no one edits the page by the time the keep expiry time
- # elapses, then no one has vetoed the last action, and the
- # action is accepted.
- # See http://www.usemod.com/cgi-bin/mb.pl?PageDeletion
- sub ProcessVetos {
- my ($expirets);
- $expirets = $Now - ($KeepDays * 24 * 60 * 60);
- return (0, T('(done)')) unless $Page{'ts'} < $expirets;
- if ($DeletedPage && $Text{'text'} =~ /^\s*$DeletedPage\W*?(\n|$)/o) {
- &DeletePage($OpenPageName, 1, 1);
- return (1, T('(deleted)'));
- }
- if ($ReplaceFile && $Text{'text'} =~ /^\s*$ReplaceFile\:\s*(\S+)/o) {
- my $fname = $1;
- # Only replace an allowed, existing file.
- if ((grep {$_ eq $fname} @ReplaceableFiles) && -e $fname) {
- if ($Text{'text'} =~ /.*<pre>.*?\n(.*?)\s*<\/pre>/ims)
- {
- my $string = $1;
- $string =~ s/\r\n/\n/gms;
- open (OUT, ">$fname") or return 0;
- print OUT $string;
- close OUT;
- return (0, T('(replaced)'));
- }
- }
- }
- return (0, T('(done)'));
- }
- sub DoMaintain {
- my ($name, $fname, $data, $message, $status);
- print &GetHeader('', T('Maintenance on all pages'), '');
- print "<br>";
- $fname = "$DataDir/maintain";
- if (!&UserIsAdmin()) {
- if ((-f $fname) && ((-M $fname) < 0.5)) {
- print T('Maintenance not done.'), ' ';
- print T('(Maintenance can only be done once every 12 hours.)');
- print ' ', T('Remove the "maintain" file or wait.');
- print &GetCommonFooter();
- return;
- }
- }
- &RequestLock() or die(T('Could not get maintain-lock'));
- foreach $name (&AllPagesList()) {
- &OpenPage($name);
- &OpenDefaultText();
- ($status, $message) = &ProcessVetos();
- &ExpireKeepFile() unless $status;
- print ".... " if ($name =~ m|/|);
- print &GetPageLink($name);
- print " $message<br>\n";
- }
- &WriteStringToFile($fname, Ts('Maintenance done at %s', &TimeToText($Now)));
- &ReleaseLock();
- # Do any rename/deletion commands
- # (Must be outside lock because it will grab its own lock)
- $fname = "$DataDir/editlinks";
- if (-f $fname) {
- $data = &ReadFileOrDie($fname);
- print '<hr>', T('Processing rename/delete commands:'), "<br>\n";
- &UpdateLinksList($data, 1, 1); # Always update RC and links
- unlink("$fname.old");
- rename($fname, "$fname.old");
- }
- if ($MaintTrimRc) {
- &RequestLock() or die(T('Could not get lock for RC maintenance'));
- $status = &TrimRc(); # Consider error messages?
- &ReleaseLock();
- }
- print &GetCommonFooter();
- }
- # Must be called within a lock.
- # Thanks to Alex Schroeder for original code
- sub TrimRc {
- my (@rc, @temp, $starttime, $days, $status, $data, $i, $ts);
- # Determine the number of days to go back
- $days = 0;
- foreach (@RcDays) {
- $days = $_ if $_ > $days;
- }
- $starttime = $Now - $days * 24 * 60 * 60;
- return 1 if (!-f $RcFile); # No work if no file exists
- ($status, $data) = &ReadFile($RcFile);
- if (!$status) {
- print '<p><strong>' . Ts('Could not open %s log file', $RCName)
- . ":</strong> $RcFile<p>"
- . T('Error was') . ":\n<pre>$!</" . "pre>\n" . '<p>';
- return 0;
- }
- # Move the old stuff from rc to temp
- @rc = split(/\n/, $data);
- for ($i = 0; $i < @rc; $i++) {
- ($ts) = split(/$FS3/, $rc[$i]);
- last if ($ts >= $starttime);
- }
- return 1 if ($i < 1); # No lines to move from new to old
- @temp = splice(@rc, 0, $i);
- # Write new files and backups
- if (!open(OUT, ">>$RcOldFile")) {
- print '<p><strong>' . Ts('Could not open %s log file', $RCName)
- . ":</strong> $RcOldFile<p>"
- . T('Error was') . ":\n<pre>$!</" . "pre>\n" . '<p>';
- return 0;
- }
- print OUT join("\n", @temp) . "\n";
- close(OUT);
- &WriteStringToFile($RcFile . '.old', $data);
- $data = join("\n", @rc);
- $data .= "\n" if ($data ne ''); # If no entries, don't add blank line
- &WriteStringToFile($RcFile, $data);
- return 1;
- }
- sub DoMaintainRc {
- print &GetHeader('', T('Maintaining RC log'), '');
- return if (!&UserIsAdminOrError());
- &RequestLock() or die(T('Could not get lock for RC maintenance'));
- if (&TrimRc()) {
- print '<br>' . T('RC maintenance done.') . '<br>';
- } else {
- print '<br>' . T('RC maintenance not done.') . '<br>';
- }
- &ReleaseLock();
- print &GetCommonFooter();
- }
- sub UserIsEditorOrError {
- if (!&UserIsEditor()) {
- print '<p>', T('This operation is restricted to site editors only...');
- print &GetCommonFooter();
- return 0;
- }
- return 1;
- }
- sub UserIsAdminOrError {
- if (!&UserIsAdmin()) {
- print '<p>', T('This operation is restricted to administrators only...');
- print &GetCommonFooter();
- return 0;
- }
- return 1;
- }
- sub DoEditLock {
- my ($fname);
- print &GetHeader('', T('Set or Remove global edit lock'), '');
- return if (!&UserIsAdminOrError());
- $fname = "$DataDir/noedit";
- if (&GetParam("set", 1)) {
- &WriteStringToFile($fname, "editing locked.");
- } else {
- unlink($fname);
- }
- if (-f $fname) {
- print '<p>', T('Edit lock created.'), '<br>';
- } else {
- print '<p>', T('Edit lock removed.'), '<br>';
- }
- print &GetCommonFooter();
- }
- sub DoPageLock {
- my ($fname, $id);
- print &GetHeader('', T('Set or Remove page edit lock'), '');
- # Consider allowing page lock/unlock at editor level?
- return if (!&UserIsAdminOrError());
- $id = &GetParam("id", "");
- if ($id eq "") {
- print '<p>', T('Missing page id to lock/unlock...');
- return;
- }
- return if (!&ValidIdOrDie($id)); # Consider nicer error?
- $fname = &GetLockedPageFile($id);
- if (&GetParam("set", 1)) {
- &WriteStringToFile($fname, "editing locked.");
- } else {
- unlink($fname);
- }
- if (-f $fname) {
- print '<p>', Ts('Lock for %s created.', $id), '<br>';
- } else {
- print '<p>', Ts('Lock for %s removed.', $id), '<br>';
- }
- print &GetCommonFooter();
- }
- sub DoEditBanned {
- my ($banList, $status);
- print &GetHeader('', T('Editing Banned list'), '');
- return if (!&UserIsAdminOrError());
- ($status, $banList) = &ReadFile("$DataDir/banlist");
- $banList = "" if (!$status);
- print &GetFormStart();
- print GetHiddenValue("edit_ban", 1), "\n";
- print "<b>Banned IP/network/host list:</b><br>\n";
- print "<p>Each entry is either a commented line (starting with #), ",
- "or a Perl regular expression (matching either an IP address or ",
- "a hostname). <b>Note:</b> To test the ban on yourself, you must ",
- "give up your admin access (remove password in Preferences).";
- print "<p>Example:<br>",
- "# blocks hosts ending with .foocorp.com<br>",
- "\\.foocorp\\.com\$<br>",
- "# blocks exact IP address<br>",
- "^123\\.21\\.3\\.9\$<br>",
- "# blocks whole 123.21.3.* IP network<br>",
- "^123\\.21\\.3\\.\\d+\$<p>";
- print &GetTextArea('banlist', $banList, 12, 50);
- print "<br>", $q->submit(-name=>'Save'), "\n";
- print $q->endform;
- if (!&GetParam('embed', $EmbedWiki)) {
- print '<div class=wikifooter>';
- print "<hr class=wikilinefooter>\n";
- print &GetGotoBar('');
- print '</div>';
- }
- print &GetMinimumFooter();
- }
- sub DoUpdateBanned {
- my ($newList, $fname);
- print &GetHeader('', T('Updating Banned list'), '');
- return if (!&UserIsAdminOrError());
- $fname = "$DataDir/banlist";
- $newList = &GetParam("banlist", "#Empty file");
- if ($newList eq "") {
- print "<p>", T('Empty banned list or error.');
- print "<p>", T('Resubmit with at least one space character to remove.');
- } elsif ($newList =~ /^\s*$/s) {
- unlink($fname);
- print "<p>", T('Removed banned list');
- } else {
- &WriteStringToFile($fname, $newList);
- print "<p>", T('Updated banned list');
- }
- print &GetCommonFooter();
- }
- # ==== Editing/Deleting pages and links ====
- sub DoEditLinks {
- print &GetHeader('', T('Editing Links'), '');
- if ($AdminDelete) {
- return if (!&UserIsAdminOrError());
- } else {
- return if (!&UserIsEditorOrError());
- }
- print &GetFormStart();
- print GetHiddenValue("edit_links", 1), "\n";
- print "<b>Editing/Deleting page titles:</b><br>\n";
- print "<p>Enter one command on each line. Commands are:<br>",
- "<tt>!PageName</tt> -- deletes the page called PageName<br>\n",
- "<tt>=OldPageName=NewPageName</tt> -- Renames OldPageName ",
- "to NewPageName and updates links to OldPageName.<br>\n",
- "<tt>|OldPageName|NewPageName</tt> -- Changes links to OldPageName ",
- "to NewPageName.",
- " (Used to rename links to non-existing pages.)<br>\n",
- "<b>Note: page names are case-sensitive!</b>\n";
- print &GetTextArea('commandlist', "", 12, 50);
- print $q->checkbox(-name=>"p_changerc", -override=>1, -checked=>1,
- -label=>"Edit $RCName");
- print "<br>\n";
- print $q->checkbox(-name=>"p_changetext", -override=>1, -checked=>1,
- -label=>"Substitute text for rename");
- print "<br>", $q->submit(-name=>'Edit'), "\n";
- print $q->endform;
- if (!&GetParam('embed', $EmbedWiki)) {
- print '<div class=wikifooter>';
- print "<hr class=wikilinefooter>\n";
- print &GetGotoBar('');
- print '</div>';
- }
- print &GetMinimumFooter();
- }
- sub UpdateLinksList {
- my ($commandList, $doRC, $doText) = @_;
- if ($doText) {
- &BuildLinkIndex();
- }
- &RequestLock() or die T('UpdateLinksList could not get main lock');
- unlink($IndexFile) if ($UseIndex);
- foreach (split(/\n/, $commandList)) {
- s/\s+$//g;
- next if (!(/^[=!|]/)); # Only valid commands.
- print "Processing $_<br>\n";
- if (/^\!(.+)/) {
- &DeletePage($1, $doRC, $doText);
- } elsif (/^\=(?:\[\[)?([^]=]+)(?:\]\])?\=(?:\[\[)?([^]=]+)(?:\]\])?/) {
- &RenamePage($1, $2, $doRC, $doText);
- } elsif (/^\|(?:\[\[)?([^]|]+)(?:\]\])?\|(?:\[\[)?([^]|]+)(?:\]\])?/) {
- &RenameTextLinks($1, $2);
- }
- }
- &NewPageCacheClear("."); # Clear cache (needs testing?)
- unlink($IndexFile) if ($UseIndex);
- &ReleaseLock();
- }
- sub BuildLinkIndex {
- my (@pglist, $page, @links, $link, %seen);
- @pglist = &AllPagesList();
- %LinkIndex = ();
- foreach $page (@pglist) {
- &BuildLinkIndexPage($page);
- }
- }
- sub BuildLinkIndexPage {
- my ($page) = @_;
- my (@links, $link, %seen);
- @links = &GetPageLinks($page, 1, 0, 0);
- %seen = ();
- foreach $link (@links) {
- if (defined($LinkIndex{$link})) {
- if (!$seen{$link}) {
- $LinkIndex{$link} .= " " . $page;
- }
- } else {
- $LinkIndex{$link} .= " " . $page;
- }
- $seen{$link} = 1;
- }
- }
- sub DoUpdateLinks {
- my ($commandList, $doRC, $doText);
- print &GetHeader('', T('Updating Links'), '');
- if ($AdminDelete) {
- return if (!&UserIsAdminOrError());
- } else {
- return if (!&UserIsEditorOrError());
- }
- $commandList = &GetParam("commandlist", "");
- $doRC = &GetParam("p_changerc", "0");
- $doRC = 1 if ($doRC eq "on");
- $doText = &GetParam("p_changetext", "0");
- $doText = 1 if ($doText eq "on");
- if ($commandList eq "") {
- print "<p>", T('Empty command list or error.');
- } else {
- &UpdateLinksList($commandList, $doRC, $doText);
- print "<p>", T('Finished command list.');
- }
- print &GetCommonFooter();
- }
- sub EditRecentChanges {
- my ($action, $old, $new) = @_;
- &EditRecentChangesFile($RcFile, $action, $old, $new, 1);
- &EditRecentChangesFile($RcOldFile, $action, $old, $new, 0);
- }
- sub EditRecentChangesFile {
- my ($fname, $action, $old, $new, $printError) = @_;
- my ($status, $fileData, $errorText, $rcline, @rclist);
- my ($outrc, $ts, $page, $junk);
- ($status, $fileData) = &ReadFile($fname);
- if (!$status) {
- # Save error text if needed.
- $errorText = "<p><strong>"
- . Ts('Could not open %s log file:', $RCName)
- . "</strong> $fname"
- . "<p>" . T('Error was:') . "\n<pre>$!</pre>\n";
- print $errorText if ($printError);
- return;
- }
- $outrc = "";
- @rclist = split(/\n/, $fileData);
- foreach $rcline (@rclist) {
- ($ts, $page, $junk) = split(/$FS3/, $rcline);
- if ($page eq $old) {
- if ($action == 1) { # Delete
- ; # Do nothing (don't add line to new RC)
- } elsif ($action == 2) {
- $junk = $rcline;
- $junk =~ s/^(\d+$FS3)$old($FS3)/"$1$new$2"/ge;
- $outrc .= $junk . "\n";
- }
- } else {
- $outrc .= $rcline . "\n";
- }
- }
- &WriteStringToFile($fname . ".old", $fileData); # Backup copy
- &WriteStringToFile($fname, $outrc);
- }
- # Delete and rename must be done inside locks.
- sub DeletePage {
- my ($page, $doRC, $doText) = @_;
- my ($fname, $status);
- $page =~ s/ /_/g;
- $page =~ s/\[+//;
- $page =~ s/\]+//;
- $status = &ValidId($page);
- if ($status ne "") {
- print Tss('Delete-Page: page %1 is invalid, error is: %2', $page, $status)
- . "<br>\n";
- return;
- }
- $fname = &GetPageFile($page);
- unlink($fname) if (-f $fname);
- $fname = $KeepDir . "/" . &GetPageDirectory($page) . "/$page.kp";
- unlink($fname) if (-f $fname);
- unlink($IndexFile) if ($UseIndex);
- &EditRecentChanges(1, $page, "") if ($doRC); # Delete page
- # Currently don't do anything with page text
- }
- # Given text, returns substituted text
- sub SubstituteTextLinks {
- my ($old, $new, $text) = @_;
- # Much of this is taken from the common markup
- %SaveUrl = ();
- $SaveUrlIndex = 0;
- $text =~ s/$FS(\d)/$1/g; # Remove separators (paranoia)
- if ($RawHtml) {
- $text =~ s/(<html>((.|\n)*?)<\/html>)/&StoreRaw($1)/ige;
- }
- $text =~ s/(<pre>((.|\n)*?)<\/pre>)/&StoreRaw($1)/ige;
- $text =~ s/(<code>((.|\n)*?)<\/code>)/&StoreRaw($1)/ige;
- $text =~ s/(<nowiki>((.|\n)*?)<\/nowiki>)/&StoreRaw($1)/ige;
- if ($FreeLinks) {
- $text =~
- s/\[\[$FreeLinkPattern\|([^\]]+)\]\]/&SubFreeLink($1,$2,$old,$new)/geo;
- $text =~ s/\[\[$FreeLinkPattern\]\]/&SubFreeLink($1,"",$old,$new)/geo;
- }
- if ($BracketText) { # Links like [URL text of link]
- $text =~ s/(\[$UrlPattern\s+([^\]]+?)\])/&StoreRaw($1)/geo;
- $text =~ s/(\[$InterLinkPattern\s+([^\]]+?)\])/&StoreRaw($1)/geo;
- }
- $text =~ s/(\[?$UrlPattern\]?)/&StoreRaw($1)/geo;
- $text =~ s/(\[?$InterLinkPattern\]?)/&StoreRaw($1)/geo;
- if ($WikiLinks) {
- $text =~ s/$LinkPattern/&SubWikiLink($1, $old, $new)/geo;
- }
- # Thanks to David Claughton for the following fix
- 1 while $text =~ s/$FS(\d+)$FS/$SaveUrl{$1}/ge; # Restore saved text
- return $text;
- }
- sub SubFreeLink {
- my ($link, $name, $old, $new) = @_;
- my ($oldlink);
- $oldlink = $link;
- $link =~ s/^\s+//;
- $link =~ s/\s+$//;
- if (($link eq $old) || (&FreeToNormal($old) eq &FreeToNormal($link))) {
- $link = $new;
- } else {
- $link = $oldlink; # Preserve spaces if no match
- }
- $link = "[[$link";
- if ($name ne "") {
- $link .= "|$name";
- }
- $link .= "]]";
- return &StoreRaw($link);
- }
- sub SubWikiLink {
- my ($link, $old, $new) = @_;
- my ($newBracket);
- $newBracket = 0;
- if ($link eq $old) {
- $link = $new;
- if (!($new =~ /^$LinkPattern$/)) {
- $link = "[[$link]]";
- }
- }
- return &StoreRaw($link);
- }
- # Rename is mostly copied from expire
- sub RenameKeepText {
- my ($page, $old, $new) = @_;
- my ($fname, $status, $data, @kplist, %tempSection, $changed);
- my ($sectName, $newText);
- $fname = $KeepDir . "/" . &GetPageDirectory($page) . "/$page.kp";
- return if (!(-f $fname));
- ($status, $data) = &ReadFile($fname);
- return if (!$status);
- @kplist = split(/$FS1/, $data, -1); # -1 keeps trailing null fields
- return if (length(@kplist) < 1); # Also empty
- shift(@kplist) if ($kplist[0] eq ""); # First can be empty
- return if (length(@kplist) < 1); # Also empty
- %tempSection = split(/$FS2/, $kplist[0], -1);
- if (!defined($tempSection{'keepts'})) {
- return;
- }
- # First pass: optimize for nothing changed
- $changed = 0;
- foreach (@kplist) {
- %tempSection = split(/$FS2/, $_, -1);
- $sectName = $tempSection{'name'};
- if ($sectName =~ /^(text_)/) {
- %Text = split(/$FS3/, $tempSection{'data'}, -1);
- $newText = &SubstituteTextLinks($old, $new, $Text{'text'});
- $changed = 1 if ($Text{'text'} ne $newText);
- }
- }
- return if (!$changed); # No sections changed
- open (OUT, ">$fname") or return;
- foreach (@kplist) {
- %tempSection = split(/$FS2/, $_, -1);
- $sectName = $tempSection{'name'};
- if ($sectName =~ /^(text_)/) {
- %Text = split(/$FS3/, $tempSection{'data'}, -1);
- $newText = &SubstituteTextLinks($old, $new, $Text{'text'});
- $Text{'text'} = $newText;
- $tempSection{'data'} = join($FS3, %Text);
- print OUT $FS1, join($FS2, %tempSection);
- } else {
- print OUT $FS1, $_;
- }
- }
- close(OUT);
- }
- sub RenameTextLinks {
- my ($old, $new) = @_;
- my ($changed, $file, $page, $section, $oldText, $newText, $status);
- my ($oldCanonical, @pageList);
- $old =~ s/ /_/g;
- $oldCanonical = &FreeToNormal($old);
- $new =~ s/ /_/g;
- $status = &ValidId($old);
- if ($status ne "") {
- print Tss('Rename-Text: old page %1 is invalid, error is: %2', $old, $status)
- . "<br>\n";
- return;
- }
- $status = &ValidId($new);
- if ($status ne "") {
- print Tss('Rename-Text: new page %1 is invalid, error is: %2', $new, $status)
- . "<br>\n";
- return;
- }
- $old =~ s/_/ /g;
- $new =~ s/_/ /g;
- # Note: the LinkIndex must be built prior to this routine
- return if (!defined($LinkIndex{$oldCanonical}));
- @pageList = split(' ', $LinkIndex{$oldCanonical});
- foreach $page (@pageList) {
- $changed = 0;
- &OpenPage($page);
- foreach $section (keys %Page) {
- if ($section =~ /^text_/) {
- &OpenSection($section);
- %Text = split(/$FS3/, $Section{'data'}, -1);
- $oldText = $Text{'text'};
- $newText = &SubstituteTextLinks($old, $new, $oldText);
- if ($oldText ne $newText) {
- $Text{'text'} = $newText;
- $Section{'data'} = join($FS3, %Text);
- $Page{$section} = join($FS2, %Section);
- $changed = 1;
- }
- } elsif ($section =~ /^cache_diff/) {
- $oldText = $Page{$section};
- $newText = &SubstituteTextLinks($old, $new, $oldText);
- if ($oldText ne $newText) {
- $Page{$section} = $newText;
- $changed = 1;
- }
- }
- # Add other text-sections (categories) here
- }
- if ($changed) {
- $file = &GetPageFile($page);
- &WriteStringToFile($file, join($FS1, %Page));
- }
- &RenameKeepText($page, $old, $new);
- }
- }
- sub RenamePage {
- my ($old, $new, $doRC, $doText) = @_;
- my ($oldfname, $newfname, $oldkeep, $newkeep, $status);
- $old =~ s/ /_/g;
- $new = &FreeToNormal($new);
- $status = &ValidId($old);
- if ($status ne "") {
- print Tss('Rename: old page %1 is invalid, error is: %2', $old, $status)
- . "<br>\n";
- return;
- }
- $status = &ValidId($new);
- if ($status ne "") {
- print Tss('Rename: new page %1 is invalid, error is: %2', $new, $status)
- . "<br>\n";
- return;
- }
- $newfname = &GetPageFile($new);
- if (-f $newfname) {
- print Ts('Rename: new page %s already exists--not renamed.', $new)
- . "<br>\n";
- return;
- }
- $oldfname = &GetPageFile($old);
- if (!(-f $oldfname)) {
- print Ts('Rename: old page %s does not exist--nothing done.', $old)
- . "<br>\n";
- return;
- }
- &CreatePageDir($PageDir, $new); # It might not exist yet
- rename($oldfname, $newfname);
- &CreatePageDir($KeepDir, $new);
- $oldkeep = $KeepDir . "/" . &GetPageDirectory($old) . "/$old.kp";
- $newkeep = $KeepDir . "/" . &GetPageDirectory($new) . "/$new.kp";
- unlink($newkeep) if (-f $newkeep); # Clean up if needed.
- rename($oldkeep, $newkeep);
- unlink($IndexFile) if ($UseIndex);
- &EditRecentChanges(2, $old, $new) if ($doRC);
- if ($doText) {
- &BuildLinkIndexPage($new); # Keep index up-to-date
- &RenameTextLinks($old, $new);
- }
- }
- sub DoShowVersion {
- print &GetHeader('', T('Displaying Wiki Version'), '');
- print "<p>UseModWiki version 1.0.4</p>\n";
- print &GetCommonFooter();
- }
- # Thanks to Phillip Riley for original code
- sub DoDeletePage {
- my ($id) = @_;
- return if (!&ValidIdOrDie($id));
- print &GetHeader('', Ts('Delete %s', $id), '');
- return if (!&UserIsAdminOrError());
- if ($ConfirmDel && !&GetParam('confirm', 0)) {
- print '<p>';
- print Ts('Confirm deletion of %s by following this link:', $id);
- print '<br>' . &GetDeleteLink($id, T('Confirm Delete'), 1);
- print '</p>';
- print &GetCommonFooter();
- return;
- }
- print '<p>';
- if ($id eq $HomePage) {
- print Ts('%s can not be deleted.', $HomePage);
- } else {
- if (-f &GetLockedPageFile($id)) {
- print Ts('%s can not be deleted because it is locked.', $id);
- } else {
- # Must lock because of RC-editing
- &RequestLock() or die(T('Could not get editing lock'));
- DeletePage($id, 1, 1);
- &ReleaseLock();
- print Ts('%s has been deleted.', $id);
- }
- }
- print '</p>';
- print &GetCommonFooter();
- }
- # Thanks to Ross Kowalski and Iliyan Jeliazkov for original uploading code
- sub DoUpload {
- print &GetHeader('', T('File Upload Page'), '');
- if (!$AllUpload) {
- return if (!&UserIsEditorOrError());
- }
- print '<p>' . Ts('The current upload size limit is %s.', $MaxPost) . ' '
- . Ts('Change the %s variable to increase this limit.', '$MaxPost');
- print '</p><br>';
- print '<FORM METHOD="post" ACTION="' . $ScriptName
- . '" ENCTYPE="multipart/form-data">';
- print '<input type="hidden" name="upload" value="1" />';
- print T('File to Upload:'), ' <INPUT TYPE="file" NAME="file"><br><BR>';
- print '<INPUT TYPE="submit" NAME="Submit" VALUE="', T('Upload'), '">';
- print '</FORM>';
- print &GetCommonFooter();
- }
- sub SaveUpload {
- my ($filename, $printFilename, $uploadFilehandle);
-
- print &GetHeader('', T('Upload Finished'), '');
- if (!$AllUpload) {
- return if (!&UserIsEditorOrError());
- }
- $UploadDir .= '/' if (substr($UploadDir, -1, 1) ne '/'); # End with /
- $UploadUrl .= '/' if (substr($UploadUrl, -1, 1) ne '/'); # End with /
- $filename = $q->param('file');
- $filename =~ s/.*[\/\\](.*)/$1/; # Only name after last \ or /
- $uploadFilehandle = $q->upload('file');
- open UPLOADFILE, ">$UploadDir$filename";
- binmode UPLOADFILE;
- while (<$uploadFilehandle>) { print UPLOADFILE; }
- close UPLOADFILE;
- print T('The wiki link to your file is:') . "\n<br><BR>";
- $printFilename = $filename;
- $printFilename =~ s/ /\%20/g; # Replace spaces with escaped spaces
- print "upload:" . $printFilename . "<BR><BR>\n";
- if ($filename =~ /$ImageExtensions$/i) {
- print '<HR><img src="' . $UploadUrl . $filename . '">' . "\n";
- }
- print &GetCommonFooter();
- }
- sub ConvertFsFile {
- my ($oldFS, $newFS, $fname) = @_;
- my ($oldData, $newData, $status);
- return if (!-f $fname); # Convert only existing regular files
- ($status, $oldData) = &ReadFile($fname);
- if (!$status) {
- print '<br><strong>' . Ts('Could not open file %s', $fname)
- . ':</strong>' . T('Error was') . ":\n<pre>$!</pre>\n" . '<br>';
- return;
- }
- $newData = $oldData;
- $newData =~ s/$oldFS(\d)/$newFS . $1/ge;
- return if ($oldData eq $newData); # Do not write if the same
- &WriteStringToFile($fname, $newData);
- # print $fname . '<br>'; # progress report
- }
- # Converts up to 3 dirs deep (like page/A/Apple/subpage.db)
- # Note that top level directory (page/keep/user) contains only dirs
- sub ConvertFsDir {
- my ($oldFS, $newFS, $topDir) = @_;
- my (@dirs, @files, @subFiles, $dir, $file, $subFile, $fname, $subFname);
- opendir(DIRLIST, $topDir);
- @dirs = readdir(DIRLIST);
- closedir(DIRLIST);
- @dirs = sort(@dirs);
- foreach $dir (@dirs) {
- next if (substr($dir, 0, 1) eq '.'); # No ., .., or .dirs
- next if (!-d "$topDir/$dir"); # Top level directories only
- next if (-f "$topDir/$dir.cvt"); # Skip if already converted
- opendir(DIRLIST, "$topDir/$dir");
- @files = readdir(DIRLIST);
- closedir(DIRLIST);
- foreach $file (@files) {
- next if (($file eq '.') || ($file eq '..'));
- $fname = "$topDir/$dir/$file";
- if (-f $fname) {
- # print $fname . '<br>'; # progress
- &ConvertFsFile($oldFS, $newFS, $fname);
- } elsif (-d $fname) {
- opendir(DIRLIST, $fname);
- @subFiles = readdir(DIRLIST);
- closedir(DIRLIST);
- foreach $subFile (@subFiles) {
- next if (($subFile eq '.') || ($subFile eq '..'));
- $subFname = "$fname/$subFile";
- if (-f $subFname) {
- # print $subFname . '<br>'; # progress
- &ConvertFsFile($oldFS, $newFS, $subFname);
- }
- }
- }
- }
- &WriteStringToFile("$topDir/$dir.cvt", 'converted');
- }
- }
- sub ConvertFsCleanup {
- my ($topDir) = @_;
- my (@dirs, $dir);
- opendir(DIRLIST, $topDir);
- @dirs = readdir(DIRLIST);
- closedir(DIRLIST);
- foreach $dir (@dirs) {
- next if (substr($dir, 0, 1) eq '.'); # No ., .., or .dirs
- next if (!-f "$topDir/$dir"); # Remove only files...
- next unless ($dir =~ m/\.cvt$/); # ...that end with .cvt
- unlink "$topDir/$dir";
- }
- }
- sub DoConvert {
- my $oldFS = "\xb3";
- my $newFS = "\x1e\xff\xfe\x1e";
- print &GetHeader('', T('Convert wiki DB'), '');
- return if (!&UserIsAdminOrError());
- if ($FS ne $newFS) {
- print Ts('You must change the %s option before converting the wiki DB.',
- '$NewFS') . '<br>';
- return;
- }
- &WriteStringToFile("$DataDir/noedit", 'editing locked.');
- print T('Wiki DB locked for conversion.') . '<br>';
- print T('Converting Wiki DB...') . '<br>';
- &ConvertFsFile($oldFS, $newFS, "$DataDir/rclog");
- &ConvertFsFile($oldFS, $newFS, "$DataDir/rclog.old");
- &ConvertFsFile($oldFS, $newFS, "$DataDir/oldrclog");
- &ConvertFsFile($oldFS, $newFS, "$DataDir/oldrclog.old");
- &ConvertFsDir($oldFS, $newFS, $PageDir);
- &ConvertFsDir($oldFS, $newFS, $KeepDir);
- &ConvertFsDir($oldFS, $newFS, $UserDir);
- &ConvertFsCleanup($PageDir);
- &ConvertFsCleanup($KeepDir);
- &ConvertFsCleanup($UserDir);
- print T('Finished converting wiki DB.') . '<br>';
- print Ts('Remove file %s to unlock wiki for editing.', "$DataDir/noedit")
- . '<br>';
- print &GetCommonFooter();
- }
- # Remove user-id files if no useful preferences set
- sub DoTrimUsers {
- my (%Data, $status, $data, $maxID, $id, $removed, $keep);
- my (@dirs, @files, $dir, $file, $item);
- print &GetHeader('', T('Trim wiki users'), '');
- return if (!&UserIsAdminOrError());
- $removed = 0;
- $maxID = 1001;
- opendir(DIRLIST, $UserDir);
- @dirs = readdir(DIRLIST);
- closedir(DIRLIST);
- foreach $dir (@dirs) {
- next if (substr($dir, 0, 1) eq '.'); # No ., .., or .dirs
- next if (!-d "$UserDir/$dir"); # Top level directories only
- opendir(DIRLIST, "$UserDir/$dir");
- @files = readdir(DIRLIST);
- closedir(DIRLIST);
- foreach $file (@files) {
- if ($file =~ m/(\d+).db/) { # Only numeric ID files
- $id = $1;
- $maxID = $id if ($id > $maxID);
- %Data = ();
- ($status, $data) = &ReadFile("$UserDir/$dir/$file");
- if ($status) {
- %Data = split(/$FS1/, $data, -1); # -1 keeps trailing null fields
- $keep = 0;
- foreach $item (qw(username password adminpw stylesheet)) {
- $keep = 1 if (defined($Data{$item}) && ($Data{$item} ne ''));
- }
- if (!$keep) {
- unlink "$UserDir/$dir/$file";
- # print "$UserDir/$dir/$file" . '<br>'; # progress
- $removed += 1;
- }
- }
- }
- }
- }
- print Ts('Removed %s files.', $removed) . '<br>';
- print Ts('Recommended $StartUID setting is %s.', $maxID + 100) . '<br>';
- print &GetCommonFooter();
- }
- #END_OF_OTHER_CODE
- &DoWikiRequest() if ($RunCGI && ($_ ne 'nocgi')); # Do everything.
- 1; # In case we are loaded from elsewhere
- # == End of UseModWiki script. ===========================================
|