HTML.pm 59 KB

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