HTML.pm 52 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561
  1. package Trog::Routes::HTML;
  2. use strict;
  3. use warnings;
  4. no warnings qw{experimental once};
  5. use feature qw{signatures state};
  6. use Errno qw{ENOENT};
  7. use File::Touch();
  8. use List::Util();
  9. use List::MoreUtils();
  10. use Capture::Tiny qw{capture};
  11. use HTML::SocialMeta;
  12. use Encode qw{encode_utf8};
  13. use IO::Compress::Gzip;
  14. use Path::Tiny();
  15. use File::Basename qw{dirname};
  16. use URI();
  17. use FindBin::libs;
  18. use Trog::Log qw{:all};
  19. use Trog::Utils;
  20. use Trog::Config;
  21. use Trog::Auth;
  22. use Trog::Data;
  23. use Trog::FileHandler;
  24. use Trog::Themes;
  25. use Trog::Renderer;
  26. use Trog::Component::EmojiPicker;
  27. my $conf = Trog::Config::get();
  28. our $landing_page = 'default.tx';
  29. our $htmltitle = 'title.tx';
  30. our $midtitle = 'midtitle.tx';
  31. our $rightbar = 'rightbar.tx';
  32. our $leftbar = 'leftbar.tx';
  33. our $topbar = 'topbar.tx';
  34. our $footbar = 'footbar.tx';
  35. our $categorybar = 'categories.tx';
  36. # Note to maintainers: never ever remove backends from this list.
  37. # the auth => 1 is a crucial protection.
  38. our %routes = (
  39. default => {
  40. callback => \&Trog::Routes::HTML::setup,
  41. },
  42. '/index' => {
  43. method => 'GET',
  44. callback => \&Trog::Routes::HTML::index,
  45. },
  46. #Deal with most indexDocument directives interfering with proxied requests to /
  47. #TODO replace with alias routes
  48. '/index.html' => {
  49. method => 'GET',
  50. callback => \&Trog::Routes::HTML::index,
  51. },
  52. '/index.php' => {
  53. method => 'GET',
  54. callback => \&Trog::Routes::HTML::index,
  55. },
  56. # This should only be enabled to debug
  57. # '/setup' => {
  58. # method => 'GET',
  59. # callback => \&Trog::Routes::HTML::setup,
  60. # },
  61. # IMPORTANT: YOU MUST setup fail2ban rules for the following routes.
  62. # TODO: Put a rule in fail2ban/ subdir, make say a generator for it based on the routes having fail2ban=1
  63. '/login' => {
  64. method => 'GET',
  65. callback => \&Trog::Routes::HTML::login,
  66. noindex => 1,
  67. },
  68. '/logout' => {
  69. method => 'GET',
  70. callback => \&Trog::Routes::HTML::logout,
  71. noindex => 1,
  72. },
  73. '/auth' => {
  74. method => 'POST',
  75. callback => \&Trog::Routes::HTML::login,
  76. noindex => 1,
  77. },
  78. '/totp' => {
  79. method => 'GET',
  80. auth => 1,
  81. callback => \&Trog::Routes::HTML::totp,
  82. },
  83. '/post/save' => {
  84. method => 'POST',
  85. auth => 1,
  86. callback => \&Trog::Routes::HTML::post_save,
  87. },
  88. '/post/delete' => {
  89. method => 'POST',
  90. auth => 1,
  91. callback => \&Trog::Routes::HTML::post_delete,
  92. },
  93. '/config/save' => {
  94. method => 'POST',
  95. auth => 1,
  96. callback => \&Trog::Routes::HTML::config_save,
  97. },
  98. '/themeclone' => {
  99. method => 'POST',
  100. auth => 1,
  101. callback => \&Trog::Routes::HTML::themeclone,
  102. },
  103. '/profile' => {
  104. method => 'POST',
  105. auth => 1,
  106. callback => \&Trog::Routes::HTML::profile,
  107. },
  108. '/manual' => {
  109. method => 'GET',
  110. auth => 1,
  111. callback => \&Trog::Routes::HTML::manual,
  112. },
  113. '/lib/(.*)' => {
  114. method => 'GET',
  115. auth => 1,
  116. captures => ['module'],
  117. callback => \&Trog::Routes::HTML::manual,
  118. },
  119. '/password_reset' => {
  120. method => 'GET',
  121. callback => \&Trog::Routes::HTML::resetpass,
  122. noindex => 1,
  123. },
  124. '/request_password_reset' => {
  125. method => 'POST',
  126. callback => \&Trog::Routes::HTML::do_resetpass,
  127. noindex => 1,
  128. },
  129. '/request_totp_clear' => {
  130. method => 'POST',
  131. callback => \&Trog::Routes::HTML::do_totp_clear,
  132. noindex => 1,
  133. },
  134. '/processed' => {
  135. method => 'GET',
  136. callback => \&Trog::Routes::HTML::processed,
  137. noindex => 1,
  138. },
  139. # END FAIL2BAN ROUTES
  140. #TODO transform into posts?
  141. '/sitemap',
  142. => {
  143. method => 'GET',
  144. callback => \&Trog::Routes::HTML::sitemap,
  145. },
  146. '/sitemap_index.xml',
  147. => {
  148. method => 'GET',
  149. callback => \&Trog::Routes::HTML::sitemap,
  150. data => { xml => 1 },
  151. },
  152. '/sitemap_index.xml.gz',
  153. => {
  154. method => 'GET',
  155. callback => \&Trog::Routes::HTML::sitemap,
  156. data => { xml => 1, compressed => 1 },
  157. },
  158. '/sitemap/static.xml' => {
  159. method => 'GET',
  160. callback => \&Trog::Routes::HTML::sitemap,
  161. data => { xml => 1, map => 'static' },
  162. },
  163. '/sitemap/static.xml.gz' => {
  164. method => 'GET',
  165. callback => \&Trog::Routes::HTML::sitemap,
  166. data => { xml => 1, compressed => 1, map => 'static' },
  167. },
  168. '/sitemap/(.*).xml' => {
  169. method => 'GET',
  170. callback => \&Trog::Routes::HTML::sitemap,
  171. data => { xml => 1 },
  172. captures => ['map'],
  173. },
  174. '/sitemap/(.*).xml.gz' => {
  175. method => 'GET',
  176. callback => \&Trog::Routes::HTML::sitemap,
  177. data => { xml => 1, compressed => 1 },
  178. captures => ['map'],
  179. },
  180. '/humans.txt' => {
  181. method => 'GET',
  182. callback => \&Trog::Routes::HTML::posts,
  183. data => { tag => ['about'] },
  184. },
  185. '/styles/avatars.css' => {
  186. method => 'GET',
  187. callback => \&Trog::Routes::HTML::avatars,
  188. data => { tag => ['about'] },
  189. },
  190. '/favicon.ico' => {
  191. method => 'GET',
  192. callback => \&Trog::Routes::HTML::icon,
  193. },
  194. '/styles/rss-style.xsl' => {
  195. method => 'GET',
  196. callback => \&Trog::Routes::HTML::rss_style,
  197. },
  198. );
  199. # Grab theme routes
  200. my $themed = 0;
  201. if ($Trog::Themes::theme_dir) {
  202. my $theme_mod = "$Trog::Themes::theme_dir/routes.pm";
  203. if ( -f $theme_mod ) {
  204. use lib '.';
  205. require $theme_mod;
  206. @routes{ keys(%Theme::routes) } = values(%Theme::routes);
  207. $themed = 1;
  208. } else {
  209. # Use the special "default" theme
  210. require Theme;
  211. }
  212. }
  213. my $data = Trog::Data->new($conf);
  214. =head1 PRIMARY ROUTE
  215. =head2 index
  216. Implements the primary route used by all pages not behind auth.
  217. Most subsequent functions simply pass content to this function.
  218. =cut
  219. sub index ( $query, $content = '', $i_styles = [] ) {
  220. $query->{theme_dir} = $Trog::Themes::td;
  221. my $to_render = $query->{template} // $landing_page;
  222. $content ||= Trog::Renderer->render( template => $to_render, data => $query, component => 1, contenttype => 'text/html' );
  223. return $content if ref $content eq "ARRAY";
  224. my @styles;
  225. unshift( @styles, qw{embed.css}) if $query->{embed};
  226. unshift( @styles, qw{screen.css structure.css});
  227. push( @styles, @$i_styles );
  228. my @p_styles = qw{print.css};
  229. #TODO allow theming of print css
  230. my @series = _get_series(0);
  231. my $title = $query->{primary_post}{title} // $query->{title} // $Theme::default_title // 'tCMS';
  232. # Handle link "unfurling" correctly
  233. my ( $default_tags, $meta_desc, $meta_tags ) = _build_social_meta( $query, $title );
  234. #Do embed content
  235. my $tmpl = $query->{embed} ? 'embed.tx' : 'index.tx';
  236. $query->{theme_dir} =~ s/^\/www\///;
  237. # TO support theming we have to do things like this rather than with an include directive in the templates.
  238. my $htmltitle = Trog::Renderer->render( template => $htmltitle, data => $query, component => 1, contenttype => 'text/html' );
  239. return $htmltitle if ref $htmltitle eq 'ARRAY';
  240. my $midtitle = Trog::Renderer->render( template => $midtitle, data => $query, component => 1, contenttype => 'text/html' );
  241. return $midtitle if ref $midtitle eq 'ARRAY';
  242. my $rightbar = Trog::Renderer->render( template => $rightbar, data => $query, component => 1, contenttype => 'text/html' );
  243. return $rightbar if ref $rightbar eq 'ARRAY';
  244. my $leftbar = Trog::Renderer->render( template => $leftbar, data => $query, component => 1, contenttype => 'text/html' );
  245. return $leftbar if ref $leftbar eq 'ARRAY';
  246. my $topbar = Trog::Renderer->render( template => $topbar, data => $query, component => 1, contenttype => 'text/html' );
  247. return $topbar if ref $topbar eq 'ARRAY';
  248. my $footbar = Trog::Renderer->render( template => $footbar, data => $query, component => 1, contenttype => 'text/html' );
  249. return $footbar if ref $footbar eq 'ARRAY';
  250. my $categorybar = Trog::Renderer->render( template => $categorybar, data => { %$query, categories => \@series}, component => 1, contenttype => 'text/html' );
  251. return $categorybar if ref $categorybar eq 'ARRAY';
  252. return finish_render(
  253. $tmpl,
  254. {
  255. %$query,
  256. search_lang => $data->lang(),
  257. search_help => $data->help(),
  258. theme_dir => $Trog::Themes::td,
  259. content => $content,
  260. title => $title,
  261. htmltitle => $htmltitle,
  262. midtitle => $midtitle,
  263. rightbar => $rightbar,
  264. leftbar => $leftbar,
  265. topbar => $topbar,
  266. footbar => $footbar,
  267. categorybar => $categorybar,
  268. categories => \@series,
  269. stylesheets => \@styles,
  270. print_styles => \@p_styles,
  271. show_madeby => $Theme::show_madeby ? 1 : 0,
  272. embed => $query->{embed} ? 1 : 0,
  273. embed_video => $query->{primary_post}{is_video},
  274. default_tags => $default_tags,
  275. meta_desc => $meta_desc,
  276. meta_tags => $meta_tags,
  277. }
  278. );
  279. }
  280. sub _build_social_meta ( $query, $title ) {
  281. return ( undef, undef, undef ) unless $query->{social_meta} && $query->{route} && $query->{domain};
  282. my $default_tags = $Theme::default_tags;
  283. $default_tags .= ',' . join( ',', @{ $query->{primary_post}->{tags} } ) if $default_tags && $query->{primary_post}->{tags};
  284. my $meta_desc = $query->{primary_post}{data} // $Theme::description // "tCMS Site";
  285. $meta_desc = Trog::Utils::strip_and_trunc($meta_desc) || '';
  286. my $meta_tags = '';
  287. my $card_type = 'summary';
  288. $card_type = 'featured_image' if $query->{primary_post} && $query->{primary_post}{is_image};
  289. $card_type = 'player' if $query->{primary_post} && $query->{primary_post}{is_video};
  290. my $image = $Theme::default_image ? "https://$query->{domain}/$Trog::Themes::td/$Theme::default_image" : '';
  291. $image = "https://$query->{domain}/$query->{primary_post}{preview}" if $query->{primary_post} && $query->{primary_post}{preview};
  292. $image = "https://$query->{domain}/$query->{primary_post}{href}" if $query->{primary_post} && $query->{primary_post}{is_image};
  293. my $primary_route = "https://$query->{domain}/$query->{route}";
  294. $primary_route =~ s/[\/]+/\//g;
  295. my $display_name = $Theme::display_name || 'Another tCMS Site';
  296. my $extra_tags = '';
  297. my %sopts = (
  298. site => '',
  299. image => '',
  300. fb_app_id => '',
  301. site_name => $display_name,
  302. app_name => $display_name,
  303. title => $title,
  304. description => $meta_desc,
  305. url => $primary_route,
  306. );
  307. $sopts{site} = $Theme::twitter_account if $Theme::twitter_account;
  308. $sopts{image} = $image if $image;
  309. $sopts{fb_app_id} = $Theme::fb_app_id if $Theme::fb_app_id;
  310. if ( $query->{primary_post} && $query->{primary_post}{is_video} ) {
  311. #$sopts{player} = "$primary_route?embed=1";
  312. $sopts{player} = "https://$query->{domain}/$query->{primary_post}{href}";
  313. #XXX don't hardcode this
  314. $sopts{player_width} = 1280;
  315. $sopts{player_height} = 720;
  316. $extra_tags .= "<meta property='og:video:type' content='$query->{primary_post}{content_type}' />\n";
  317. }
  318. my $social = HTML::SocialMeta->new(%sopts);
  319. $meta_tags = eval { $social->create($card_type) };
  320. $meta_tags =~ s/content="video"/content="video:other"/mg if $meta_tags;
  321. $meta_tags .= $extra_tags if $extra_tags;
  322. print STDERR "WARNING: Theme misconfigured, social media tags will not be included\n$@\n" if $Trog::Themes::theme_dir && !$meta_tags;
  323. return ( $default_tags, $meta_desc, $meta_tags );
  324. }
  325. =head1 ADMIN ROUTES
  326. These are things that issue returns other than 200, and are not directly accessible by users via any defined route.
  327. =head2 notfound, forbidden, badrequest
  328. Implements the 4XX status codes. Override templates named the same for theming this.
  329. =cut
  330. sub _generic_route ( $rname, $code, $title, $query ) {
  331. $query->{code} = $code;
  332. $query->{route} //= $rname;
  333. $query->{title} = $title;
  334. $query->{template} = "$rname.tx";
  335. return Trog::Routes::HTML::index( $query );
  336. }
  337. sub notfound (@args) {
  338. return _generic_route( 'notfound', 404, "Return to sender, Address unknown", @args );
  339. }
  340. sub forbidden (@args) {
  341. return _generic_route( 'forbidden', 403, "STAY OUT YOU RED MENACE", @args );
  342. }
  343. sub badrequest (@args) {
  344. return _generic_route( 'badrequest', 400, "Bad Request", @args );
  345. }
  346. sub toolong (@args) {
  347. return _generic_route( 'toolong', 419, "URI too long", @args );
  348. }
  349. sub error (@args) {
  350. return _generic_route( 'error', 500, "Internal Server Error", @args);
  351. }
  352. =head2 redirect, redirect_permanent, see_also
  353. Redirects to the provided page.
  354. =cut
  355. sub redirect ($to) {
  356. INFO("redirect: $to");
  357. return [ 302, [ "Location" => $to ], [''] ];
  358. }
  359. sub redirect_permanent ($to) {
  360. INFO("permanent redirect: $to");
  361. return [ 301, [ "Location" => $to ], [''] ];
  362. }
  363. sub see_also ($to) {
  364. INFO("see also: $to");
  365. return [ 303, [ "Location" => $to ], [''] ];
  366. }
  367. =head1 NORMAL ROUTES
  368. These are expected to either return a 200, or redirect to something which does.
  369. =head2 setup
  370. One time setup page; should only display to the first user to visit the site which we presume to be the administrator.
  371. =cut
  372. sub setup ($query) {
  373. File::Touch::touch("config/setup");
  374. Trog::Renderer->render(
  375. template => 'notconfigured.tx',
  376. data => {
  377. title => 'tCMS Requires Setup to Continue...',
  378. stylesheets => _build_themed_styles(['notconfigured.css']),
  379. %$query,
  380. },
  381. contenttype => 'text/html',
  382. code => 200,
  383. );
  384. }
  385. =head2 totp
  386. Enable 2 factor auth via TOTP for the currently authenticated user.
  387. Returns a page with a QR code & TOTP uri for pasting into your authenticator app of choice.
  388. =cut
  389. sub totp ($query) {
  390. my $active_user = $query->{user};
  391. my $domain = $query->{domain};
  392. $query->{failure} //= -1;
  393. my ( $uri, $qr, $failure, $message ) = Trog::Auth::totp( $active_user, $domain );
  394. return Trog::Routes::HTML::index(
  395. {
  396. title => 'Enable TOTP 2-Factor Auth',
  397. theme_dir => $Trog::Themes::td,
  398. uri => $uri,
  399. qr => $qr,
  400. failure => $failure,
  401. message => $message,
  402. template => 'totp.tx',
  403. is_admin => 1,
  404. %$query,
  405. },
  406. undef,
  407. [qw{post.css}],
  408. );
  409. }
  410. =head2 login
  411. Sets the user cookie if the provided user exists, or sets up the user as an admin with the provided credentials in the event that no users exist.
  412. =cut
  413. sub login ($query) {
  414. # Redirect if we actually have a logged in user.
  415. # Note to future me -- this user value is overwritten explicitly in server.psgi.
  416. # If that ever changes, you will die
  417. $query->{to} //= $query->{route};
  418. $query->{to} = '/config' if List::Util::any { $query->{to} eq $_ } qw{/login /logout};
  419. if ( $query->{user} ) {
  420. DEBUG("Login by $query->{user}, redirecting to $query->{to}");
  421. return see_also( $query->{to} );
  422. }
  423. #Check and see if we have no users. If so we will just accept whatever creds are passed.
  424. my $hasusers = -f "config/has_users";
  425. my $btnmsg = $hasusers ? "Log In" : "Register";
  426. my $headers;
  427. my $has_totp = 0;
  428. if ( $query->{username} && $query->{password} ) {
  429. if ( !$hasusers ) {
  430. # Make the first user
  431. Trog::Auth::useradd( $query->{username}, $query->{display_name}, $query->{password}, ['admin'], $query->{contact_email} );
  432. # Add a stub user page and the initial series.
  433. my $dat = Trog::Data->new($conf);
  434. _setup_initial_db( $dat, $query->{username} );
  435. # Ensure we stop registering new users
  436. File::Touch::touch("config/has_users");
  437. }
  438. $query->{failed} = 1;
  439. my $cookie = Trog::Auth::mksession( $query->{username}, $query->{password}, $query->{token} );
  440. if ($cookie) {
  441. # TODO secure / sameSite cookie to kill csrf, maybe do rememberme with Expires=~0
  442. my $secure = '';
  443. $secure = '; Secure' if $query->{scheme} eq 'https';
  444. $headers = {
  445. "Set-Cookie" => "tcmslogin=$cookie; HttpOnly; SameSite=Strict$secure",
  446. };
  447. $query->{failed} = 0;
  448. }
  449. }
  450. $query->{failed} //= -1;
  451. return Trog::Renderer->render(
  452. template => 'login.tx',
  453. data => {
  454. title => 'tCMS 2 ~ Login',
  455. to => $query->{to},
  456. failure => int( $query->{failed} ),
  457. message => int( $query->{failed} ) < 1 ? "Login Successful, Redirecting..." : "Login Failed.",
  458. btnmsg => $btnmsg,
  459. stylesheets => _build_themed_styles([qw{login.css}]),
  460. theme_dir => $Trog::Themes::td,
  461. has_users => $hasusers,
  462. %$query,
  463. },
  464. headers => $headers,
  465. contenttype => 'text/html',
  466. code => 200,
  467. );
  468. }
  469. sub _setup_initial_db ( $dat, $user ) {
  470. $dat->add(
  471. {
  472. "aclname" => "series",
  473. "acls" => [],
  474. "callback" => "Trog::Routes::HTML::series",
  475. method => 'GET',
  476. "data" => "Series",
  477. "href" => "/series",
  478. "local_href" => "/series",
  479. "preview" => "/img/sys/testpattern.jpg",
  480. "tags" => [qw{series topbar}],
  481. visibility => 'public',
  482. "title" => "Series",
  483. user => $user,
  484. form => 'series.tx',
  485. child_form => 'series.tx',
  486. aliases => [],
  487. },
  488. {
  489. "aclname" => "about",
  490. "acls" => [],
  491. "callback" => "Trog::Routes::HTML::series",
  492. method => 'GET',
  493. "data" => "About",
  494. "href" => "/about",
  495. "local_href" => "/about",
  496. "preview" => "/img/sys/testpattern.jpg",
  497. "tags" => [qw{series topbar public}],
  498. visibility => 'public',
  499. "title" => "About",
  500. user => $user,
  501. form => 'series.tx',
  502. child_form => 'profile.tx',
  503. aliases => [],
  504. },
  505. {
  506. "aclname" => "config",
  507. acls => [],
  508. "callback" => "Trog::Routes::HTML::config",
  509. 'method' => 'GET',
  510. "content_type" => "text/html",
  511. "data" => "Config",
  512. "href" => "/config",
  513. "local_href" => "/config",
  514. "preview" => "/img/sys/testpattern.jpg",
  515. "tags" => [qw{admin}],
  516. visibility => 'private',
  517. "title" => "Configure tCMS",
  518. user => $user,
  519. aliases => [],
  520. },
  521. {
  522. title => $user,
  523. data => 'Default user',
  524. preview => '/img/avatar/humm.gif',
  525. wallpaper => '/img/sys/testpattern.jpg',
  526. tags => ['about'],
  527. visibility => 'public',
  528. acls => ['admin'],
  529. local_href => "/users/$user",
  530. callback => "Trog::Routes::HTML::users",
  531. method => 'GET',
  532. user => $user,
  533. form => 'profile.tx',
  534. aliases => [],
  535. },
  536. );
  537. }
  538. =head2 logout
  539. Deletes your users' session and opens the index.
  540. =cut
  541. sub logout ($query) {
  542. Trog::Auth::killsession( $query->{user} ) if $query->{user};
  543. delete $query->{user};
  544. return Trog::Routes::HTML::index($query);
  545. }
  546. =head2 config
  547. Renders the configuration page, or redirects you back to the login page.
  548. =cut
  549. sub config ($query) {
  550. return see_also('/login') unless $query->{user};
  551. return Trog::Routes::HTML::forbidden($query) unless grep { $_ eq 'admin' } @{ $query->{user_acls} };
  552. $query->{failure} //= -1;
  553. return Trog::Routes::HTML::index(
  554. {
  555. title => 'Configure tCMS',
  556. theme_dir => $Trog::Themes::td,
  557. stylesheets => [qw{config.css}],
  558. scripts => [qw{post.js}],
  559. themes => _get_themes() || [],
  560. data_models => _get_data_models(),
  561. current_theme => $conf->param('general.theme') // '',
  562. current_data_model => $conf->param('general.data_model') // 'DUMMY',
  563. totp_secret => $conf->param('totp.secret'),
  564. message => $query->{message},
  565. failure => $query->{failure},
  566. to => '/config',
  567. scheme => $query->{scheme},
  568. embeds => $conf->param('security.allow_embeds_from') // '',
  569. is_admin => 1,
  570. template => 'config.tx',
  571. %$query,
  572. },
  573. undef,
  574. [qw{config.css}],
  575. );
  576. }
  577. =head2 resetpass
  578. =head2 do_resetpass
  579. =head2 do_totp_clear
  580. Routes for user service of their authentication details.
  581. =cut
  582. sub resetpass($query) {
  583. $query->{failure} //= -1;
  584. return Trog::Routes::HTML::index(
  585. {
  586. title => 'Request Authentication Resets',
  587. theme_dir => $Trog::Themes::td,
  588. stylesheets => [qw{config.css}],
  589. scripts => [qw{post.js}],
  590. message => $query->{message},
  591. failure => $query->{failure},
  592. scheme => $query->{scheme},
  593. template => 'resetpass.tx',
  594. %$query,
  595. },
  596. undef,
  597. [qw{config.css}],
  598. );
  599. }
  600. sub do_resetpass($query) {
  601. my $user = $query->{username};
  602. # User Does not exist
  603. return Trog::Routes::HTML::forbidden($query) if !Trog::Auth::user_exists($user);
  604. # User exists, but is not logged in this session
  605. return Trog::Routes::HTML::forbidden($query) if !$query->{user} && Trog::Auth::user_has_session($user);
  606. my $token = Trog::Utils::uuid();
  607. my $newpass = $query->{password} // Trog::Utils::uuid();
  608. my $res = Trog::Auth::add_change_request( type => 'reset_pass', user => $user, secret => $newpass, token => $token );
  609. die "Could not add auth change request!" unless $res;
  610. # If the user is logged in, just do the deed, otherwise send them the token in an email
  611. if ($query->{user}) {
  612. return see_also("/api/auth_change_request/$token");
  613. }
  614. Trog::Email::contact(
  615. $user,
  616. "root\@$query->{domain}",
  617. "$query->{domain}: Password reset URL for $user",
  618. { uri => "$query->{scheme}://$query->{domain}/api/auth_change_request/$token", template => 'password_reset.tx' }
  619. );
  620. return see_also("/processed");
  621. }
  622. sub do_totp_clear($query) {
  623. my $user = $query->{username};
  624. # User Does not exist
  625. return Trog::Routes::HTML::forbidden($query) if !Trog::Auth::user_exists($user);
  626. # User exists, but is not logged in this session
  627. return Trog::Routes::HTML::forbidden($query) if !$query->{user} && Trog::Auth::user_has_session($user);
  628. my $token = Trog::Utils::uuid();
  629. my $res = Trog::Auth::add_change_request( type => 'clear_totp', user => $user, token => $token );
  630. die "Could not add auth change request!" unless $res;
  631. # If the user is logged in, just do the deed, otherwise send them the token in an email
  632. if ($query->{user}) {
  633. return see_also("/api/auth_change_request/$token");
  634. }
  635. Trog::Email::contact(
  636. $user,
  637. "root\@$query->{domain}",
  638. "$query->{domain}: Password reset URL for $user",
  639. { uri => "$query->{scheme}://$query->{domain}/api/auth_change_request/$token", template => 'totp_reset.tx' }
  640. );
  641. return see_also("/processed");
  642. }
  643. sub _get_series ( $edit = 0 ) {
  644. my @series = $data->get(
  645. acls => [qw{public}],
  646. tags => [qw{topbar}],
  647. limit => 10,
  648. page => 1,
  649. );
  650. @series = map { $_->{local_href} = "/post$_->{local_href}"; $_ } @series if $edit;
  651. return @series;
  652. }
  653. sub _get_themes {
  654. my $dir = 'www/themes';
  655. opendir( my $dh, $dir ) || do { die "Can't opendir $dir: $!" unless $!{ENOENT} };
  656. my @tdirs = grep { !/^\./ && -d "$dir/$_" } readdir($dh);
  657. closedir $dh;
  658. return \@tdirs;
  659. }
  660. sub _get_data_models {
  661. my $dir = 'lib/Trog/Data';
  662. opendir( my $dh, $dir ) || die "Can't opendir $dir: $!";
  663. my @dmods = map { s/\.pm$//g; $_ } grep { /\.pm$/ && -f "$dir/$_" } readdir($dh);
  664. closedir $dh;
  665. return \@dmods;
  666. }
  667. =head2 config_save
  668. Implements /config/save route. Saves what little configuration we actually use to ~/.tcms/tcms.conf
  669. =cut
  670. sub config_save ($query) {
  671. return see_also('/login') unless $query->{user};
  672. return Trog::Routes::HTML::forbidden($query) unless grep { $_ eq 'admin' } @{ $query->{user_acls} };
  673. $conf->param( 'general.theme', $query->{theme} ) if defined $query->{theme};
  674. $conf->param( 'general.data_model', $query->{data_model} ) if $query->{data_model};
  675. # Erase all TOTP secrets in the event we change the global secret
  676. if ( $query->{totp_secret} ) {
  677. $conf->param( 'totp.secret', $query->{totp_secret} );
  678. Trog::Auth::clear_totp();
  679. }
  680. $query->{failure} = 1;
  681. $query->{message} = "Failed to save configuration!";
  682. if ( $conf->write($Trog::Config::home_cfg) ) {
  683. $query->{failure} = 0;
  684. $query->{message} = "Configuration updated succesfully.";
  685. }
  686. #Get the PID of the parent port using lsof, send HUP
  687. my $parent = getppid;
  688. kill 'HUP', $parent;
  689. return config($query);
  690. }
  691. =head2 themeclone
  692. Clone a theme by copying a directory.
  693. =cut
  694. sub themeclone ($query) {
  695. return see_also('/login') unless $query->{user};
  696. return Trog::Routes::HTML::forbidden($query) unless grep { $_ eq 'admin' } @{ $query->{user_acls} };
  697. my ( $theme, $newtheme ) = ( $query->{theme}, $query->{newtheme} );
  698. my $themedir = 'www/themes';
  699. $query->{failure} = 1;
  700. $query->{message} = "Failed to clone theme '$theme' as '$newtheme'!";
  701. require File::Copy::Recursive;
  702. if ( $theme && $newtheme && File::Copy::Recursive::dircopy( "$themedir/$theme", "$themedir/$newtheme" ) ) {
  703. $query->{failure} = 0;
  704. $query->{message} = "Successfully cloned theme '$theme' as '$newtheme'.";
  705. }
  706. return see_also('/config');
  707. }
  708. =head2 post_save
  709. Saves posts submitted via the /post pages
  710. =cut
  711. sub post_save ($query) {
  712. return see_also('/login') unless $query->{user};
  713. return Trog::Routes::HTML::forbidden($query) unless grep { $_ eq 'admin' } @{ $query->{user_acls} };
  714. my $to = delete $query->{to};
  715. #Copy this down since it will be deleted later
  716. my $acls = $query->{acls};
  717. $query->{tags} = Trog::Utils::coerce_array( $query->{tags} );
  718. # Filter bits and bobs
  719. delete $query->{primary_post};
  720. delete $query->{social_meta};
  721. delete $query->{deflate};
  722. delete $query->{acls};
  723. # Ensure there are no null tags
  724. @{ $query->{tags} } = grep { defined $_ } @{ $query->{tags} };
  725. # Posts will always be GET
  726. $query->{method} = 'GET';
  727. $data->add($query) and die "Could not add post";
  728. return see_also($to);
  729. }
  730. =head2 profile
  731. Saves / updates new users.
  732. =cut
  733. sub profile ($query) {
  734. return see_also('/login') unless $query->{user};
  735. return Trog::Routes::HTML::forbidden($query) unless grep { $_ eq 'admin' } @{ $query->{user_acls} };
  736. #TODO allow new users to do something OTHER than be admins
  737. #TODO allow username changes
  738. if ( $query->{password} || $query->{contact_email} ) {
  739. my @acls = Trog::Auth::acls4user($query->{username}) || qw{admin};
  740. Trog::Auth::useradd( $query->{username}, $query->{display_name}, $query->{password}, \@acls, $query->{contact_email} );
  741. }
  742. #Make sure it is "self-authored", redact pw
  743. $query->{user} = delete $query->{username};
  744. delete $query->{password};
  745. delete $query->{contact_email};
  746. return post_save($query);
  747. }
  748. =head2 post_delete
  749. deletes posts.
  750. =cut
  751. sub post_delete ($query) {
  752. return see_also('/login') unless $query->{user};
  753. return Trog::Routes::HTML::forbidden($query) unless grep { $_ eq 'admin' } @{ $query->{user_acls} };
  754. $data->delete($query) and die "Could not delete post";
  755. return see_also( $query->{to} );
  756. }
  757. =head2 series
  758. Series specific view, much like the users/ route
  759. Displays identified series, not all series.
  760. =cut
  761. sub series ($query) {
  762. my $is_admin = grep { $_ eq 'admin' } @{ $query->{user_acls} };
  763. #we are either viewed one of two ways, /post/$id or /$aclname
  764. my ( undef, $aclname, $id ) = split( /\//, $query->{route} );
  765. $query->{aclname} = $aclname if !$id;
  766. $query->{id} = $id if $id;
  767. # Don't show topbar series on the series page. That said, don't exclude it from direct series view.
  768. $query->{exclude_tags} = ['topbar'] if !$is_admin && $aclname && $aclname eq 'series';
  769. #XXX I'd prefer to overload id to actually *be* the aclname...
  770. # but this way, accomodates things like the flat file time-indexing hack.
  771. # TODO I should probably have it for all posts, and make *everything* a series.
  772. # WE can then do threaded comments/posts.
  773. # That will essentially necessitate it *becoming* the ID for real.
  774. #Grab the relevant tag (aclname), then pass that to posts
  775. my @posts = _post_helper( $query, ['series'], $query->{user_acls} );
  776. delete $query->{id};
  777. delete $query->{aclname};
  778. $query->{subhead} = $posts[0]->{data};
  779. $query->{title} = $posts[0]->{title};
  780. $query->{tag} = $posts[0]->{aclname};
  781. $query->{primary_post} = $posts[0];
  782. $query->{in_series} = 1;
  783. return posts($query);
  784. }
  785. =head2 avatars
  786. Returns the avatars.css.
  787. =cut
  788. sub avatars ($query) {
  789. push( @{ $query->{user_acls} }, 'public' );
  790. my $tags = Trog::Utils::coerce_array( $query->{tag} );
  791. my @posts = _post_helper( $query, $tags, $query->{user_acls} );
  792. if (@posts) {
  793. # Set the eTag so that we don't get a re-fetch
  794. $query->{etag} = "$posts[0]{id}-$posts[0]{version}";
  795. }
  796. return Trog::Renderer->render(
  797. template => 'avatars.tx',
  798. data => {
  799. users => \@posts,
  800. %$query,
  801. },
  802. code => 200,
  803. contenttype => 'text/css',
  804. );
  805. }
  806. =head2 users
  807. Implements direct user profile view.
  808. =cut
  809. sub users ($query) {
  810. # Capture the username
  811. my ( undef, undef, $username ) = split( /\//, $query->{route} );
  812. $query->{username} //= $username;
  813. push( @{ $query->{user_acls} }, 'public' );
  814. $query->{exclude_tags} = ['about'];
  815. # Don't show topbar series on the series page. That said, don't exclude it from direct series view.
  816. my $is_admin = grep { $_ eq 'admin' } @{ $query->{user_acls} };
  817. push( @{ $query->{exclude_tags} }, 'topbar' ) if !$is_admin;
  818. my @posts = _post_helper( { author => $query->{username} }, ['about'], $query->{user_acls} );
  819. $query->{id} = $posts[0]->{id};
  820. $query->{title} = $posts[0]->{title};
  821. $query->{user_obj} = $posts[0];
  822. $query->{primary_post} = $posts[0];
  823. $query->{in_series} = 1;
  824. return posts($query);
  825. }
  826. =head2 posts
  827. Display multi or single posts, supports RSS and pagination.
  828. =cut
  829. sub posts ( $query, $direct = 0 ) {
  830. # Allow rss.xml to tell what posts to loop over
  831. my $fmt = $query->{format} || '';
  832. #Process the input URI to capture tag/id
  833. $query->{route} //= $query->{to};
  834. my ( undef, undef, $id ) = split( /\//, $query->{route} );
  835. my $tags = Trog::Utils::coerce_array( $query->{tag} );
  836. $query->{id} = $id if $id && !$query->{in_series};
  837. my $is_admin = grep { $_ eq 'admin' } @{ $query->{user_acls} };
  838. push( @{ $query->{user_acls} }, 'public' );
  839. push( @{ $query->{user_acls} }, 'unlisted' ) if $query->{id};
  840. push( @{ $query->{user_acls} }, 'private' ) if $is_admin;
  841. my @posts;
  842. # Discover this user's visibility, so we can make them post in this category by default
  843. my $user_visibility = 'public';
  844. if ( $query->{user_obj} ) {
  845. #Optimize the /users/* route
  846. @posts = ( $query->{user_obj} );
  847. $user_visibility = $query->{user_obj}->{visibility};
  848. }
  849. else {
  850. if ( $query->{user} ) {
  851. my @me = _post_helper( { author => $query->{user} }, ['about'], $query->{user_acls} );
  852. $user_visibility = $me[0]->{visibility};
  853. }
  854. @posts = _post_helper( $query, $tags, $query->{user_acls} );
  855. }
  856. if ( $query->{id} ) {
  857. $query->{primary_post} = $posts[0] if @posts;
  858. }
  859. #OK, so if we have a user as the ID we found, go grab the rest of their posts
  860. if ( $query->{id} && @posts && List::Util::any { $_ eq 'about' } @{ $posts[0]->{tags} } ) {
  861. my $user = shift(@posts);
  862. my $id = delete $query->{id};
  863. $query->{author} = $user->{user};
  864. @posts = _post_helper( $query, $tags, $query->{user_acls} );
  865. @posts = grep { $_->{id} ne $id } @posts;
  866. unshift @posts, $user;
  867. }
  868. if ( !$is_admin ) {
  869. return notfound($query) unless @posts;
  870. }
  871. # Set the eTag so that we don't get a re-fetch
  872. $query->{etag} = "$posts[0]{id}-$posts[0]{version}" if @posts;
  873. #Correct page headers
  874. my $ph = $themed ? _themed_title( $query->{route} ) : $query->{route};
  875. return _rss( $query, $ph, \@posts ) if $fmt eq 'rss';
  876. #XXX Is used by the sitemap, maybe just fix there?
  877. my @post_aliases = map { $_->{local_href} } _get_series();
  878. # Allow themes to put in custom headers/footers on posts
  879. my ( $header, $footer );
  880. $header = Trog::Renderer->render(
  881. template => 'headers/' . $query->{primary_post}{header},
  882. data => { theme_dir => $Trog::Themes::td, %$query },
  883. component => 1,
  884. contenttype => 'text/html',
  885. ) if $query->{primary_post}{header};
  886. return $header if ref $header eq 'ARRAY';
  887. $footer = Trog::Renderer->render(
  888. template => 'footers/' . $query->{primary_post}{footer},
  889. data => { theme_dir => $Trog::Themes::td, %$query },
  890. component => 1,
  891. contenttype => 'text/html',
  892. ) if $query->{primary_post}{footer};
  893. return $header if ref $footer eq 'ARRAY';
  894. # List the available headers/footers
  895. my $headers = Trog::Themes::templates_in_dir( "headers", 'text/html', 1 );
  896. my $footers = Trog::Themes::templates_in_dir( "footers", 'text/html', 1 );
  897. #XXX used to be post.css, but probably not good anymore?
  898. my $styles = [];
  899. # Build page title if it wasn't set by a wrapping sub
  900. $query->{title} = "$query->{domain} : $query->{title}" if $query->{title} && $query->{domain};
  901. $query->{title} ||= @$tags && $query->{domain} ? "$query->{domain} : @$tags" : undef;
  902. #Handle paginator vars
  903. my $limit = int( $query->{limit} || 25 );
  904. my $now_year = ( localtime(time) )[5] + 1900;
  905. my $oldest_year = $now_year - 20; #XXX actually find oldest post year
  906. # Handle post style.
  907. if ( $query->{style} ) {
  908. undef $header;
  909. undef $footer;
  910. }
  911. my $older = !@posts ? 0 : $posts[-1]->{created};
  912. $query->{failure} //= -1;
  913. $query->{id} //= '';
  914. my $newer = !@posts ? 0 : $posts[0]->{created};
  915. #XXX messed up data has to be fixed unfortunately
  916. @$tags = List::Util::uniq @$tags;
  917. #Filter displaying visibility tags
  918. my @visibuddies = qw{public unlisted private};
  919. foreach my $post (@posts) {
  920. @{ $post->{tags} } = grep {
  921. my $tag = $_;
  922. !grep { $tag eq $_ } @visibuddies
  923. } @{ $post->{tags} };
  924. }
  925. #XXX note that we are explicitly relying on the first tag to be the ACL
  926. my $aclselected = $tags->[0] || '';
  927. my @acls = map {
  928. $_->{selected} = $_->{aclname} eq $aclselected ? 'selected' : '';
  929. $_
  930. } _post_helper( {}, ['series'], $query->{user_acls} );
  931. my $forms = Trog::Themes::templates_in_dir("forms", 'text/html', 1);
  932. my $edittype = $query->{primary_post} ? $query->{primary_post}->{child_form} : $query->{form};
  933. my $tiled = $query->{primary_post} ? !$is_admin && $query->{primary_post}->{tiled} : 0;
  934. # Grab the rest of the tags to dump into the edit form
  935. my @tags_all = $data->tags();
  936. #Filter out the visibilities and special series tags
  937. @tags_all = grep {
  938. my $subj = $_;
  939. scalar( grep { $_ eq $subj } qw{public private unlisted admin series about topbar} ) == 0
  940. } @tags_all;
  941. @posts = map {
  942. my $subject = $_;
  943. my @et = grep {
  944. my $subj = $_;
  945. grep { $subj eq $_ } @tags_all
  946. } @{ $subject->{tags} };
  947. @et = grep { $_ ne $aclselected } @et;
  948. $_->{extra_tags} = \@et;
  949. $_
  950. } @posts;
  951. my @et = List::MoreUtils::singleton( @$tags, @tags_all );
  952. $query->{author} = $query->{primary_post}{user} // $posts[0]{user};
  953. my $picker = Trog::Component::EmojiPicker::render();
  954. return $picker if ref $picker eq 'ARRAY';
  955. #XXX the only reason this is needed is due to direct=1
  956. #XXX is this even used?
  957. my $content = Trog::Renderer->render(
  958. template => 'posts.tx',
  959. data => {
  960. acls => \@acls,
  961. can_edit => $is_admin,
  962. forms => $forms,
  963. post => { tags => $tags, extra_tags => \@et, form => $edittype, visibility => $user_visibility, addpost => 1 },
  964. post_visibilities => \@visibuddies,
  965. failure => $query->{failure},
  966. to => $query->{to},
  967. message => $query->{failure} ? "Failed to add post!" : "Successfully added Post as $query->{id}",
  968. direct => $direct,
  969. title => $query->{title},
  970. author => $query->{primary_post}{user} // $posts[0]{user},
  971. style => $query->{style},
  972. posts => \@posts,
  973. like => $query->{like},
  974. in_series => exists $query->{in_series} || !!( $query->{route} =~ m/^\/series\// ),
  975. route => $query->{route},
  976. limit => $limit,
  977. pages => scalar(@posts) == $limit,
  978. older => $older,
  979. newer => $newer,
  980. sizes => [ 25, 50, 100 ],
  981. rss => !$query->{id} && !$query->{older},
  982. tiled => $tiled,
  983. category => $ph,
  984. subhead => $query->{subhead},
  985. header => $header,
  986. footer => $footer,
  987. headers => $headers,
  988. footers => $footers,
  989. years => [ reverse( $oldest_year .. $now_year ) ],
  990. months => [ 0 .. 11 ],
  991. emoji_picker => $picker,
  992. embed => $query->{embed},
  993. },
  994. contenttype => 'text/html',
  995. component => 1,
  996. );
  997. # Something exploded
  998. return $content if ref $content eq "ARRAY";
  999. return $content if $direct;
  1000. return Trog::Routes::HTML::index( $query, $content, $styles );
  1001. }
  1002. sub _themed_title ($path) {
  1003. return $path unless %Theme::paths;
  1004. return $Theme::paths{$path} ? $Theme::paths{$path} : $path;
  1005. }
  1006. sub _post_helper ( $query, $tags, $acls ) {
  1007. return $data->get(
  1008. older => $query->{older},
  1009. newer => $query->{newer},
  1010. page => int( $query->{page} || 1 ),
  1011. limit => int( $query->{limit} || 25 ),
  1012. tags => $tags,
  1013. exclude_tags => $query->{exclude_tags},
  1014. acls => $acls,
  1015. aclname => $query->{aclname},
  1016. like => $query->{like},
  1017. author => $query->{author},
  1018. id => $query->{id},
  1019. version => $query->{version},
  1020. );
  1021. }
  1022. =head2 sitemap
  1023. Return the sitemap index unless the static or a set of dynamic routes is requested.
  1024. We have a maximum of 99,990,000 posts we can make under this model
  1025. As we have 10,000 * 10,000 posts which are indexable via the sitemap format.
  1026. 1 top level index slot (10k posts) is taken by our static routes, the rest will be /posts.
  1027. Passing ?xml=1 will result in an appropriate sitemap.xml instead.
  1028. This is used to generate the static sitemaps as expected by search engines.
  1029. Passing compressed=1 will gzip the output.
  1030. =cut
  1031. sub sitemap ($query) {
  1032. state $etag = "sitemap-" . time();
  1033. my ( @to_map, $is_index, $route_type );
  1034. my $warning = '';
  1035. $query->{map} //= '';
  1036. if ( $query->{map} eq 'static' ) {
  1037. # Return the map of static routes
  1038. $route_type = 'Static Routes';
  1039. @to_map = grep { !defined $routes{$_}->{captures} && !$routes{$_}->{auth} && !$routes{$_}->{noindex} } keys(%routes);
  1040. }
  1041. elsif ( !$query->{map} ) {
  1042. # Return the index instead
  1043. @to_map = ('static');
  1044. my $tot = $data->count();
  1045. my $size = 50000;
  1046. my $pages = int( $tot / $size ) + ( ( $tot % $size ) ? 1 : 0 );
  1047. # Truncate pages at 10k due to standard
  1048. my $clamped = $pages > 49999 ? 49999 : $pages;
  1049. $warning = "More posts than possible to represent in sitemaps & index! Old posts have been truncated." if $pages > 49999;
  1050. foreach my $page ( $clamped .. 1 ) {
  1051. push( @to_map, "$page" );
  1052. }
  1053. $is_index = 1;
  1054. }
  1055. else {
  1056. $route_type = "Posts: Page $query->{map}";
  1057. # Return the map of the particular range of dynamic posts
  1058. $query->{limit} = 50000;
  1059. $query->{page} = $query->{map};
  1060. @to_map = _post_helper( $query, [], ['public'] );
  1061. }
  1062. if ( $query->{xml} ) {
  1063. DEBUG("RENDER SITEMAP XML");
  1064. my $sm;
  1065. my $xml_date = time();
  1066. my $fmt = "xml";
  1067. $fmt .= ".gz" if $query->{compressed};
  1068. if ( !$query->{map} ) {
  1069. require WWW::SitemapIndex::XML;
  1070. $sm = WWW::SitemapIndex::XML->new();
  1071. foreach my $url (@to_map) {
  1072. $sm->add(
  1073. loc => "http://$query->{domain}/sitemap/$url.$fmt",
  1074. lastmod => $xml_date,
  1075. );
  1076. }
  1077. }
  1078. else {
  1079. require WWW::Sitemap::XML;
  1080. $sm = WWW::Sitemap::XML->new();
  1081. my $changefreq = $query->{map} eq 'static' ? 'monthly' : 'daily';
  1082. foreach my $url (@to_map) {
  1083. my $true_uri = "http://$query->{domain}$url";
  1084. if ( ref $url eq 'HASH' ) {
  1085. my $is_user_page = grep { $_ eq 'about' } @{ $url->{tags} };
  1086. $true_uri = "http://$query->{domain}/posts/$url->{id}";
  1087. $true_uri = "http://$query->{domain}/users/$url->{title}" if $is_user_page;
  1088. }
  1089. my %out = (
  1090. loc => $true_uri,
  1091. lastmod => $xml_date,
  1092. mobile => 1,
  1093. changefreq => $changefreq,
  1094. priority => 1.0,
  1095. );
  1096. if ( ref $url eq 'HASH' ) {
  1097. #add video & preview image if applicable
  1098. $out{images} = [
  1099. {
  1100. loc => "http://$query->{domain}$url->{href}",
  1101. caption => $url->{data},
  1102. title => substr( $url->{title}, 0, 100 ),
  1103. }
  1104. ]
  1105. if $url->{is_image};
  1106. # Truncate descriptions
  1107. my $desc = substr( $url->{data}, 0, 2048 ) || '';
  1108. my $href = $url->{href} || '';
  1109. my $preview = $url->{preview} || '';
  1110. my $domain = $query->{domain} || '';
  1111. $out{videos} = [
  1112. {
  1113. content_loc => "http://$domain$href",
  1114. thumbnail_loc => "http://$domain$preview",
  1115. title => substr( $url->{title}, 0, 100 ) || '',
  1116. description => $desc,
  1117. }
  1118. ]
  1119. if $url->{is_video};
  1120. }
  1121. $sm->add(%out);
  1122. }
  1123. }
  1124. my $xml = $sm->as_xml();
  1125. require IO::String;
  1126. my $buf = IO::String->new();
  1127. my $ct = 'application/xml';
  1128. $xml->toFH( $buf, 0 );
  1129. seek $buf, 0, 0;
  1130. if ( $query->{compressed} ) {
  1131. require IO::Compress::Gzip;
  1132. my $compressed = IO::String->new();
  1133. IO::Compress::Gzip::gzip( $buf => $compressed );
  1134. $ct = 'application/gzip';
  1135. $buf = $compressed;
  1136. seek $compressed, 0, 0;
  1137. }
  1138. #XXX This is one of the few exceptions where we don't use finish_render, as it *requires* gzip.
  1139. return [ 200, [ "Content-type" => $ct, 'ETag' => $etag ], $buf ];
  1140. }
  1141. @to_map = sort @to_map unless $is_index;
  1142. my $styles = ['sitemap.css'];
  1143. $query->{title} = "$query->{domain} : Sitemap";
  1144. $query->{template} = 'sitemap.tx',
  1145. $query->{to_map} = \@to_map,
  1146. $query->{is_index} = $is_index,
  1147. $query->{route_type} = $route_type,
  1148. $query->{etag} = $etag;
  1149. return Trog::Routes::HTML::index( $query, undef, $styles );
  1150. }
  1151. sub _rss ( $query, $subtitle, $posts ) {
  1152. require XML::RSS;
  1153. my $rss = XML::RSS->new( version => '2.0', stylesheet => '/styles/rss-style.xsl' );
  1154. my $now = DateTime->from_epoch( epoch => time() );
  1155. my $port = $query->{port} ? ":$query->{port}" : '';
  1156. $rss->channel(
  1157. title => "$query->{domain}",
  1158. subtitle => $subtitle,
  1159. link => "http://$query->{domain}$port/$query->{route}?format=xml",
  1160. language => 'en', #TODO localization
  1161. description => "$query->{domain} : $query->{route}",
  1162. pubDate => $now,
  1163. lastBuildDate => $now,
  1164. );
  1165. $rss->image(
  1166. title => $query->{domain},
  1167. url => "/favicon.ico",
  1168. link => "http://$query->{domain}$port",
  1169. width => 32,
  1170. height => 32,
  1171. description => "$query->{domain} favicon",
  1172. );
  1173. foreach my $post (@$posts) {
  1174. my $url = "http://$query->{domain}$port$post->{local_href}";
  1175. _post2rss( $rss, $url, $post );
  1176. next unless ref $post->{aliases} eq 'ARRAY';
  1177. foreach my $alias ( @{ $post->{aliases} } ) {
  1178. $url = "http://$query->{domain}$port$alias";
  1179. _post2rss( $rss, $url, $post );
  1180. }
  1181. }
  1182. return Trog::Renderer->render(
  1183. template => 'raw.tx',
  1184. data => {
  1185. etag => $query->{etag},
  1186. body => encode_utf8( $rss->as_string ),
  1187. scheme => $query->{scheme},
  1188. },
  1189. headers => { 'Content-Disposition' => 'inline; filename="rss.xml"' },
  1190. #XXX if you do the "proper" content-type of application/rss+xml, browsers download rather than display.
  1191. contenttype => "text/xml",
  1192. code => 200,
  1193. );
  1194. }
  1195. sub _post2rss ( $rss, $url, $post ) {
  1196. $rss->add_item(
  1197. title => $post->{title},
  1198. permaLink => $url,
  1199. link => $url,
  1200. enclosure => { url => $url, type => "text/html" },
  1201. description => "<![CDATA[$post->{data}]]>",
  1202. pubDate => DateTime->from_epoch( epoch => $post->{created} ), #TODO format like Thu, 23 Aug 1999 07:00:00 GMT
  1203. author => $post->{user}, #TODO translate to "email (user)" format
  1204. );
  1205. }
  1206. =head2 manual
  1207. Implements the /manual and /lib/* routes.
  1208. Basically a thin wrapper around Pod::Html.
  1209. =cut
  1210. sub manual ($query) {
  1211. return see_also('/login') unless $query->{user};
  1212. return Trog::Routes::HTML::forbidden($query) unless grep { $_ eq 'admin' } @{ $query->{user_acls} };
  1213. require Pod::Html;
  1214. require Capture::Tiny;
  1215. #Fix links from Pod::HTML
  1216. $query->{module} =~ s/\.html$//g if $query->{module};
  1217. $query->{failure} //= -1;
  1218. my $infile = $query->{module} ? "$query->{module}.pm" : 'tCMS/Manual.pod';
  1219. return notfound($query) unless -f "lib/$infile";
  1220. my $content = capture { Pod::Html::pod2html( qw{--podpath=lib --podroot=.}, "--infile=lib/$infile" ) };
  1221. return Trog::Routes::HTML::index(
  1222. {
  1223. title => 'tCMS Manual',
  1224. theme_dir => $Trog::Themes::td,
  1225. content => $content,
  1226. template => 'manual.tx',
  1227. is_admin => 1,
  1228. %$query,
  1229. },
  1230. undef,
  1231. ['post.css'],
  1232. );
  1233. }
  1234. sub processed ($query) {
  1235. return Trog::Routes::HTML::index({
  1236. title => "Your request has been processed",
  1237. theme_dir => $Trog::Themes::td,
  1238. },
  1239. "Your request has been processed.<br /><br />You will recieve subsequent communications about this matter via means you have provided earlier.",
  1240. ['post.css']);
  1241. }
  1242. # basically a file rewrite rule for themes
  1243. sub icon ($query) {
  1244. my $path = $query->{route};
  1245. return Trog::FileHandler::serve(Trog::Themes::themed("img/icon/$path"));
  1246. }
  1247. # TODO make statics, abstract gzipped outputting & header handling
  1248. sub rss_style ($query) {
  1249. $query->{port} = ":$query->{port}" if $query->{port};
  1250. $query->{title} = qq{<xsl:value-of select="rss/channel/title"/>};
  1251. $query->{no_doctype} = 1;
  1252. # Due to this being html rather than XML, we can't use an include directive.
  1253. $query->{header} = Trog::Renderer->render( template => 'header.tx', data => $query, contenttype => 'text/html', component => 1 );
  1254. $query->{footer} = Trog::Renderer->render( template => 'footer.tx', data => $query, contenttype => 'text/html', component => 1 );
  1255. return Trog::Renderer->render(
  1256. template => 'rss-style.tx',
  1257. contenttype => 'text/xsl',
  1258. data => $query,
  1259. code => 200,
  1260. );
  1261. }
  1262. sub _build_themed_styles ($styles) {
  1263. my @styles = map { Trog::Themes::themed_style("$_") } @{Trog::Utils::coerce_array($styles)};
  1264. return \@styles;
  1265. }
  1266. sub _build_themed_scripts ($scripts) {
  1267. my @scripts = map { Trog::Themes::themed_script("$_") } @{Trog::Utils::coerce_array($scripts)};
  1268. return \@scripts;
  1269. }
  1270. sub finish_render ( $template, $vars, %headers ) {
  1271. #XXX default vars that need to be pulled from config
  1272. $vars->{lang} //= 'en-US';
  1273. $vars->{title} //= 'tCMS';
  1274. $vars->{stylesheets} //= [];
  1275. $vars->{scripts} //= [];
  1276. # Theme-ize the paths
  1277. $vars->{stylesheets} = [map { s/^www\///; $_ } grep { -f $_ } @{_build_themed_styles($vars->{stylesheets})}];
  1278. $vars->{print_styles} = [map { s/^www\///; $_ } grep { -f $_ } @{_build_themed_styles($vars->{p_styles})}];
  1279. $vars->{scripts} = [map { s/^www\///; $_ } grep { -f $_ } @{_build_themed_scripts($vars->{scripts})}];
  1280. # Add in avatars.css, it's special
  1281. push(@{$vars->{stylesheets}},"/styles/avatars.css");
  1282. # Absolute-ize the paths for scripts & stylesheets
  1283. @{ $vars->{stylesheets} } = map { CORE::index( $_, '/' ) == 0 ? $_ : "/$_" } @{ $vars->{stylesheets} };
  1284. @{ $vars->{print_styles} } = map { CORE::index( $_, '/' ) == 0 ? $_ : "/$_" } @{ $vars->{print_styles} };
  1285. @{ $vars->{scripts} } = map { CORE::index( $_, '/' ) == 0 ? $_ : "/$_" } @{ $vars->{scripts} };
  1286. # TODO Smash together the stylesheets and minify
  1287. $vars->{contenttype} //= $Trog::Vars::content_types{html};
  1288. $vars->{cachecontrol} //= $Trog::Vars::cache_control{revalidate};
  1289. $vars->{code} ||= 200;
  1290. $vars->{theme_dir} =~ s/^\/www\/// if $vars->{theme_dir};
  1291. $vars->{header} = Trog::Renderer->render( template => 'header.tx', data => $vars, contenttype => 'text/html', component => 1 );
  1292. $vars->{footer} = Trog::Renderer->render( template => 'footer.tx', data => $vars, contenttype => 'text/html', component => 1 );
  1293. return Trog::Renderer->render( template => $template, data => $vars, contenttype => 'text/html', code => $vars->{code} );
  1294. }
  1295. 1;