HTML.pm 51 KB

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