HTML.pm 41 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251
  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 Capture::Tiny qw{capture};
  10. use HTML::SocialMeta;
  11. use Trog::Utils;
  12. use Trog::Config;
  13. use Trog::Data;
  14. my $conf = Trog::Config::get();
  15. my $template_dir = 'www/templates';
  16. my $theme_dir = '';
  17. $theme_dir = "themes/".$conf->param('general.theme') if $conf->param('general.theme') && -d "www/themes/".$conf->param('general.theme');
  18. my $td = $theme_dir ? "/$theme_dir" : '';
  19. use lib 'www';
  20. our $landing_page = 'default.tx';
  21. our $htmltitle = 'title.tx';
  22. our $midtitle = 'midtitle.tx';
  23. our $rightbar = 'rightbar.tx';
  24. our $leftbar = 'leftbar.tx';
  25. our $footbar = 'footbar.tx';
  26. # Note to maintainers: never ever remove backends from this list.
  27. # the auth => 1 is a crucial protection, even with forbidden() guards in these routes.
  28. our %routes = (
  29. default => {
  30. callback => \&Trog::Routes::HTML::setup,
  31. },
  32. '/' => {
  33. method => 'GET',
  34. callback => \&Trog::Routes::HTML::index,
  35. },
  36. #Deal with most indexDocument directives interfering with proxied requests to /
  37. '/index.html' => {
  38. method => 'GET',
  39. callback => \&Trog::Routes::HTML::index,
  40. },
  41. '/index.php' => {
  42. method => 'GET',
  43. callback => \&Trog::Routes::HTML::index,
  44. },
  45. # This should only be enabled to debug
  46. # '/setup' => {
  47. # method => 'GET',
  48. # callback => \&Trog::Routes::HTML::setup,
  49. # },
  50. '/login' => {
  51. method => 'GET',
  52. callback => \&Trog::Routes::HTML::login,
  53. },
  54. '/logout' => {
  55. method => 'GET',
  56. callback => \&Trog::Routes::HTML::logout,
  57. },
  58. '/auth' => {
  59. method => 'POST',
  60. nostatic => 1,
  61. callback => \&Trog::Routes::HTML::login,
  62. },
  63. '/post/save' => {
  64. method => 'POST',
  65. auth => 1,
  66. callback => \&Trog::Routes::HTML::post_save,
  67. },
  68. '/post/delete' => {
  69. method => 'POST',
  70. auth => 1,
  71. callback => \&Trog::Routes::HTML::post_delete,
  72. },
  73. '/config/save' => {
  74. method => 'POST',
  75. auth => 1,
  76. callback => \&Trog::Routes::HTML::config_save,
  77. },
  78. '/themeclone' => {
  79. method => 'POST',
  80. auth => 1,
  81. callback => \&Trog::Routes::HTML::themeclone,
  82. },
  83. '/profile' => {
  84. method => 'POST',
  85. auth => 1,
  86. callback => \&Trog::Routes::HTML::profile,
  87. },
  88. '/manual' => {
  89. method => 'GET',
  90. auth => 1,
  91. callback => \&Trog::Routes::HTML::manual,
  92. },
  93. '/lib/(.*)' => {
  94. method => 'GET',
  95. auth => 1,
  96. captures => ['module'],
  97. callback => \&Trog::Routes::HTML::manual,
  98. },
  99. #TODO transform into posts?
  100. '/sitemap', => {
  101. method => 'GET',
  102. callback => \&Trog::Routes::HTML::sitemap,
  103. },
  104. '/sitemap_index.xml', => {
  105. method => 'GET',
  106. callback => \&Trog::Routes::HTML::sitemap,
  107. data => { xml => 1 },
  108. },
  109. '/sitemap_index.xml.gz', => {
  110. method => 'GET',
  111. callback => \&Trog::Routes::HTML::sitemap,
  112. data => { xml => 1, compressed => 1 },
  113. },
  114. '/sitemap/static.xml' => {
  115. method => 'GET',
  116. callback => \&Trog::Routes::HTML::sitemap,
  117. data => { xml => 1, map => 'static' },
  118. },
  119. '/sitemap/static.xml.gz' => {
  120. method => 'GET',
  121. callback => \&Trog::Routes::HTML::sitemap,
  122. data => { xml => 1, compressed => 1, map => 'static' },
  123. },
  124. '/sitemap/(.*).xml' => {
  125. method => 'GET',
  126. callback => \&Trog::Routes::HTML::sitemap,
  127. data => { xml => 1 },
  128. captures => ['map'],
  129. },
  130. '/sitemap/(.*).xml.gz' => {
  131. method => 'GET',
  132. callback => \&Trog::Routes::HTML::sitemap,
  133. data => { xml => 1, compressed => 1},
  134. captures => ['map'],
  135. },
  136. '/robots.txt' => {
  137. method => 'GET',
  138. callback => \&Trog::Routes::HTML::robots,
  139. },
  140. '/humans.txt' => {
  141. method => 'GET',
  142. callback => \&Trog::Routes::HTML::posts,
  143. data => { tag => ['about'] },
  144. },
  145. '/styles/avatars.css' => {
  146. method => 'GET',
  147. callback => \&Trog::Routes::HTML::avatars,
  148. data => { tag => ['about'] },
  149. },
  150. );
  151. # Grab theme routes
  152. my $themed = 0;
  153. if ($theme_dir) {
  154. my $theme_mod = "$theme_dir/routes.pm";
  155. if (-f "www/$theme_mod" ) {
  156. require $theme_mod;
  157. @routes{keys(%Theme::routes)} = values(%Theme::routes);
  158. $themed = 1;
  159. }
  160. }
  161. =head1 PRIMARY ROUTE
  162. =head2 index
  163. Implements the primary route used by all pages not behind auth.
  164. Most subsequent functions simply pass content to this function.
  165. =cut
  166. sub index ($query,$render_cb, $content = '', $i_styles = []) {
  167. $query->{theme_dir} = $td;
  168. my $processor = Text::Xslate->new(
  169. path => $template_dir,
  170. );
  171. my $t_processor;
  172. $t_processor = Text::Xslate->new(
  173. path => "www/$theme_dir/templates",
  174. ) if $theme_dir;
  175. $content ||= _pick_processor("templates/$landing_page",$processor,$t_processor)->render($landing_page,$query);
  176. my @styles = ('/styles/avatars.css');
  177. if ($theme_dir) {
  178. if ($query->{embed}) {
  179. unshift(@styles, _themed_style("embed.css")) if -f 'www/'._themed_style("embed.css");
  180. }
  181. unshift(@styles, _themed_style("screen.css")) if -f 'www/'._themed_style("screen.css");
  182. unshift(@styles, _themed_style("structure.css")) if -f 'www/'._themed_style("structure.css");
  183. }
  184. push( @styles, @$i_styles );
  185. #TODO allow theming of print css
  186. my $search_info = Trog::Data->new($conf);
  187. my @series = _get_series(0, $search_info);
  188. my $title = $query->{primary_post}{title} // $query->{title} // $Theme::default_title // 'tCMS';
  189. # Handle link "unfurling" correctly
  190. my ($default_tags, $meta_desc, $meta_tags) = _build_social_meta($query,$title);
  191. #Do embed content
  192. my $tmpl = $query->{embed} ? 'embed.tx' : 'index.tx';
  193. return $render_cb->( $tmpl, {
  194. code => $query->{code},
  195. user => $query->{user},
  196. search_lang => $search_info->lang(),
  197. search_help => $search_info->help(),
  198. route => $query->{route},
  199. domain => $query->{domain},
  200. theme_dir => $td,
  201. content => $content,
  202. title => $title,
  203. htmltitle => _pick_processor("templates/$htmltitle" ,$processor,$t_processor)->render($htmltitle,$query),
  204. midtitle => _pick_processor("templates/$midtitle" ,$processor,$t_processor)->render($midtitle,$query),
  205. rightbar => _pick_processor("templates/$rightbar" ,$processor,$t_processor)->render($rightbar,$query),
  206. leftbar => _pick_processor("templates/$leftbar" ,$processor,$t_processor)->render($leftbar,$query),
  207. footbar => _pick_processor("templates/$footbar" ,$processor,$t_processor)->render($footbar,$query),
  208. categories => \@series,
  209. stylesheets => \@styles,
  210. show_madeby => $Theme::show_madeby ? 1 : 0,
  211. embed => $query->{embed} ? 1 : 0,
  212. embed_video => $query->{primary_post}{is_video},
  213. default_tags => $default_tags,
  214. meta_desc => $meta_desc,
  215. meta_tags => $meta_tags,
  216. deflate => $query->{deflate},
  217. });
  218. }
  219. sub _build_social_meta ($query,$title) {
  220. return (undef,undef,undef) unless $query->{social_meta};
  221. my $default_tags = $Theme::default_tags;
  222. $default_tags .= ','.join(',',@{$query->{primary_post}->{tags}}) if $default_tags && $query->{primary_post}->{tags};
  223. my $meta_desc = $query->{primary_post}{data} // $Theme::description // "tCMS Site";
  224. $meta_desc = Trog::Utils::strip_and_trunc($meta_desc);
  225. my $meta_tags = '';
  226. my $card_type = 'summary';
  227. $card_type = 'featured_image' if $query->{primary_post} && $query->{primary_post}{is_image};
  228. $card_type = 'player' if $query->{primary_post} && $query->{primary_post}{is_video};
  229. my $image = $Theme::default_image ? "https://$query->{domain}/$td/$Theme::default_image" : '';
  230. $image = "https://$query->{domain}/$query->{primary_post}{preview}" if $query->{primary_post} && $query->{primary_post}{preview};
  231. $image = "https://$query->{domain}/$query->{primary_post}{href}" if $query->{primary_post} && $query->{primary_post}{is_image};
  232. my $primary_route = "https://$query->{domain}/$query->{route}";
  233. $primary_route =~ s/[\/]+/\//g;
  234. my $display_name = $Theme::display_name // 'Another tCMS Site';
  235. my $extra_tags ='';
  236. my %sopts = (
  237. site_name => $display_name,
  238. app_name => $display_name,
  239. title => $title,
  240. description => $meta_desc,
  241. url => $primary_route,
  242. );
  243. $sopts{site} = $Theme::twitter_account if $Theme::twitter_account;
  244. $sopts{image} = $image if $image;
  245. $sopts{fb_app_id} = $Theme::fb_app_id if $Theme::fb_app_id;
  246. if ($query->{primary_post} && $query->{primary_post}{is_video}) {
  247. #$sopts{player} = "$primary_route?embed=1";
  248. $sopts{player} = "https://$query->{domain}/$query->{primary_post}{href}";
  249. #XXX don't hardcode this
  250. $sopts{player_width} = 1280;
  251. $sopts{player_height} = 720;
  252. $extra_tags .= "<meta property='og:video:type' content='$query->{primary_post}{content_type}' />\n";
  253. }
  254. my $social = HTML::SocialMeta->new(%sopts);
  255. $meta_tags = eval { $social->create($card_type) };
  256. $meta_tags =~ s/content="video"/content="video:other"/mg if $meta_tags;
  257. $meta_tags .= $extra_tags if $extra_tags;
  258. print STDERR "WARNING: Theme misconfigured, social media tags will not be included\n$@\n" if $theme_dir && !$meta_tags;
  259. return ($default_tags, $meta_desc, $meta_tags);
  260. }
  261. =head1 ADMIN ROUTES
  262. These are things that issue returns other than 200, and are not directly accessible by users via any defined route.
  263. =head2 notfound, forbidden, badrequest
  264. Implements the 4XX status codes. Override templates named the same for theming this.
  265. =cut
  266. sub _generic_route ($rname, $code, $title, $query, $render_cb) {
  267. $query->{code} = $code;
  268. my $processor = Text::Xslate->new(
  269. path => _dir_for_resource("$rname.tx"),
  270. );
  271. $query->{title} = $title;
  272. my $styles = _build_themed_styles("$rname.css");
  273. my $content = $processor->render("$rname.tx", {
  274. title => $title,
  275. route => $query->{route},
  276. user => $query->{user},
  277. styles => $styles,
  278. deflate => $query->{deflate},
  279. });
  280. return Trog::Routes::HTML::index($query, $render_cb, $content, $styles);
  281. }
  282. sub notfound (@args) {
  283. return _generic_route('notfound',404,"Return to sender, Address unknown", @args);
  284. }
  285. sub forbidden (@args) {
  286. return _generic_route('forbidden', 403, "STAY OUT YOU RED MENACE", @args);
  287. }
  288. sub badrequest (@args) {
  289. return _generic_route('badrequest', 400, "Bad Request", @args);
  290. }
  291. sub redirect ($to) {
  292. return [302, ["Location" => $to],['']]
  293. }
  294. sub redirect_permanent ($to) {
  295. return [301, ["Location" => $to], ['']];
  296. }
  297. =head1 NORMAL ROUTES
  298. These are expected to either return a 200, or redirect to something which does.
  299. =head2 robots
  300. Return an appropriate robots.txt
  301. =cut
  302. sub robots ($query, $render_cb) {
  303. my $processor = Text::Xslate->new(
  304. path => $template_dir,
  305. );
  306. return [200, ["Content-type:text/plain\n"],[$processor->render('robots.tx', { domain => $query->{domain} })]];
  307. }
  308. =head2 setup
  309. One time setup page; should only display to the first user to visit the site which we presume to be the administrator.
  310. =cut
  311. sub setup ($query, $render_cb) {
  312. File::Touch::touch("config/setup");
  313. return $render_cb->('notconfigured.tx', {
  314. title => 'tCMS Requires Setup to Continue...',
  315. stylesheets => _build_themed_styles('notconfigured.css'),
  316. });
  317. }
  318. =head2 login
  319. 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.
  320. =cut
  321. sub login ($query, $render_cb) {
  322. # Redirect if we actually have a logged in user.
  323. # Note to future me -- this user value is overwritten explicitly in server.psgi.
  324. # If that ever changes, you will die
  325. $query->{to} //= $query->{route};
  326. $query->{to} = '/config' if $query->{to} eq '/login';
  327. if ($query->{user}) {
  328. return $routes{$query->{to}}{callback}->($query,$render_cb);
  329. }
  330. #Check and see if we have no users. If so we will just accept whatever creds are passed.
  331. my $hasusers = -f "config/has_users";
  332. my $btnmsg = $hasusers ? "Log In" : "Register";
  333. my @headers;
  334. if ($query->{username} && $query->{password}) {
  335. if (!$hasusers) {
  336. # Make the first user
  337. Trog::Auth::useradd($query->{username}, $query->{password}, ['admin'] );
  338. # Add a stub user page and the initial series.
  339. my $dat = Trog::Data->new($conf);
  340. _setup_initial_db($dat,$query->{username});
  341. # Ensure we stop registering new users
  342. File::Touch::touch("config/has_users");
  343. }
  344. $query->{failed} = 1;
  345. my $cookie = Trog::Auth::mksession($query->{username}, $query->{password});
  346. if ($cookie) {
  347. # TODO secure / sameSite cookie to kill csrf, maybe do rememberme with Expires=~0
  348. my $secure = '';
  349. $secure = '; Secure' if $query->{scheme} eq 'https';
  350. @headers = (
  351. "Set-Cookie" => "tcmslogin=$cookie; HttpOnly; SameSite=Strict$secure",
  352. );
  353. $query->{failed} = 0;
  354. }
  355. }
  356. $query->{failed} //= -1;
  357. return $render_cb->('login.tx', {
  358. title => 'tCMS 2 ~ Login',
  359. to => $query->{to},
  360. failure => int( $query->{failed} ),
  361. message => int( $query->{failed} ) < 1 ? "Login Successful, Redirecting..." : "Login Failed.",
  362. btnmsg => $btnmsg,
  363. stylesheets => _build_themed_styles('login.css'),
  364. theme_dir => $td,
  365. }, @headers);
  366. }
  367. sub _setup_initial_db ($dat, $user) {
  368. $dat->add(
  369. {
  370. "aclname" => "series",
  371. "acls" => [],
  372. "callback" => "Trog::Routes::HTML::series",
  373. method => 'GET',
  374. "data" => "Series",
  375. "href" => "/series",
  376. "local_href" => "/series",
  377. "preview" => "/img/sys/testpattern.jpg",
  378. "tags" => [qw{series topbar}],
  379. visibility => 'public',
  380. "title" => "Series",
  381. user => $user,
  382. form => 'series.tx',
  383. child_form => 'series.tx',
  384. aliases => [],
  385. },
  386. {
  387. "aclname" => "about",
  388. "acls" => [],
  389. "callback" => "Trog::Routes::HTML::series",
  390. method => 'GET',
  391. "data" => "About",
  392. "href" => "/about",
  393. "local_href" => "/about",
  394. "preview" => "/img/sys/testpattern.jpg",
  395. "tags" => [qw{series topbar public}],
  396. visibility => 'public',
  397. "title" => "About",
  398. user => $user,
  399. form => 'series.tx',
  400. child_form => 'profile.tx',
  401. aliases => [],
  402. },
  403. {
  404. "aclname" => "config",
  405. acls => [],
  406. "callback" => "Trog::Routes::HTML::config",
  407. 'method' => 'GET',
  408. "content_type" => "text/html",
  409. "data" => "Config",
  410. "href" => "/config",
  411. "local_href" => "/config",
  412. "preview" => "/img/sys/testpattern.jpg",
  413. "tags" => [qw{admin}],
  414. visibility => 'private',
  415. "title" => "Configure tCMS",
  416. user => $user,
  417. aliases => [],
  418. },
  419. {
  420. title => $user,
  421. data => 'Default user',
  422. preview => '/img/avatar/humm.gif',
  423. wallpaper => '/img/sys/testpattern.jpg',
  424. tags => ['about'],
  425. visibility => 'public',
  426. acls => ['admin'],
  427. local_href => "/users/$user",
  428. callback => "Trog::Routes::HTML::users",
  429. method => 'GET',
  430. user => $user,
  431. form => 'profile.tx',
  432. aliases => [],
  433. },
  434. );
  435. }
  436. =head2 logout
  437. Deletes your users' session and opens the index.
  438. =cut
  439. sub logout ($query, $render_cb) {
  440. Trog::Auth::killsession($query->{user}) if $query->{user};
  441. delete $query->{user};
  442. return Trog::Routes::HTML::index($query,$render_cb);
  443. }
  444. =head2 config
  445. Renders the configuration page, or redirects you back to the login page.
  446. =cut
  447. sub config ($query, $render_cb) {
  448. if (!$query->{user}) {
  449. return login($query,$render_cb);
  450. }
  451. #NOTE: we are relying on this to skip the ACL check with 'admin', this may not be viable in future?
  452. return forbidden($query, $render_cb) unless grep { $_ eq 'admin' } @{$query->{acls}};
  453. my $css = _build_themed_styles('config.css');
  454. my $js = _build_themed_scripts('post.js');
  455. $query->{failure} //= -1;
  456. my @series = _get_series(1);
  457. return $render_cb->('config.tx', {
  458. title => 'Configure tCMS',
  459. theme_dir => $td,
  460. stylesheets => $css,
  461. scripts => $js,
  462. categories => \@series,
  463. themes => _get_themes() || [],
  464. data_models => _get_data_models(),
  465. current_theme => $conf->param('general.theme') // '',
  466. current_data_model => $conf->param('general.data_model') // 'DUMMY',
  467. message => $query->{message},
  468. failure => $query->{failure},
  469. to => '/config',
  470. });
  471. }
  472. sub _get_series($edit=0,$search_info=0) {
  473. $search_info ||= Trog::Data->new($conf);
  474. my @series = $search_info->get(
  475. acls => [qw{public}],
  476. tags => [qw{topbar}],
  477. limit => 10,
  478. page => 1,
  479. );
  480. @series = map { $_->{local_href} = "/post$_->{local_href}"; $_ } @series if $edit;
  481. return @series;
  482. }
  483. sub _get_themes {
  484. my $dir = 'www/themes';
  485. opendir(my $dh, $dir) || do { die "Can't opendir $dir: $!" unless $!{ENOENT} };
  486. my @tdirs = grep { !/^\./ && -d "$dir/$_" } readdir($dh);
  487. closedir $dh;
  488. return \@tdirs;
  489. }
  490. sub _get_data_models {
  491. my $dir = 'lib/Trog/Data';
  492. opendir(my $dh, $dir) || die "Can't opendir $dir: $!";
  493. my @dmods = map { s/\.pm$//g; $_ } grep { /\.pm$/ && -f "$dir/$_" } readdir($dh);
  494. closedir $dh;
  495. return \@dmods
  496. }
  497. =head2 config_save
  498. Implements /config/save route. Saves what little configuration we actually use to ~/.tcms/tcms.conf
  499. =cut
  500. sub config_save ($query, $render_cb) {
  501. return forbidden($query, $render_cb) unless grep { $_ eq 'admin' } @{$query->{acls}};
  502. $conf->param( 'general.theme', $query->{theme} ) if defined $query->{theme};
  503. $conf->param( 'general.data_model', $query->{data_model} ) if $query->{data_model};
  504. $query->{failure} = 1;
  505. $query->{message} = "Failed to save configuration!";
  506. if ($conf->write($Trog::Config::home_cfg)) {
  507. $query->{failure} = 0;
  508. $query->{message} = "Configuration updated succesfully.";
  509. }
  510. #Get the PID of the parent port using lsof, send HUP
  511. my $parent = getppid;
  512. kill 'HUP', $parent;
  513. return config($query, $render_cb);
  514. }
  515. =head2 themeclone
  516. Clone a theme by copying a directory.
  517. =cut
  518. sub themeclone ($query, $render_cb) {
  519. return forbidden($query, $render_cb) unless grep { $_ eq 'admin' } @{$query->{acls}};
  520. my ($theme, $newtheme) = ($query->{theme},$query->{newtheme});
  521. my $themedir = 'www/themes';
  522. $query->{failure} = 1;
  523. $query->{message} = "Failed to clone theme '$theme' as '$newtheme'!";
  524. require File::Copy::Recursive;
  525. if ($theme && $newtheme && File::Copy::Recursive::dircopy( "$themedir/$theme", "$themedir/$newtheme" )) {
  526. $query->{failure} = 0;
  527. $query->{message} = "Successfully cloned theme '$theme' as '$newtheme'.";
  528. }
  529. return config($query, $render_cb);
  530. }
  531. =head2 post_save
  532. Saves posts submitted via the /post pages
  533. =cut
  534. sub post_save ($query, $render_cb) {
  535. return forbidden($query, $render_cb) unless grep { $_ eq 'admin' } @{$query->{acls}};
  536. my $to = delete $query->{to};
  537. #Copy this down since it will be deleted later
  538. my $acls = $query->{acls};
  539. state $data = Trog::Data->new($conf);
  540. $query->{tags} = _coerce_array($query->{tags});
  541. # Filter bits and bobs
  542. delete $query->{primary_post};
  543. delete $query->{social_meta};
  544. delete $query->{deflate};
  545. delete $query->{acls};
  546. # Ensure there are no null tags
  547. @{$query->{tags}} = grep { defined $_ } @{$query->{tags}};
  548. $query->{failure} = $data->add($query);
  549. $query->{to} = $to;
  550. $query->{acls} = $acls;
  551. $query->{message} = $query->{failure} ? "Failed to add post!" : "Successfully added Post";
  552. delete $query->{id};
  553. return posts($query, $render_cb);
  554. }
  555. =head2 profile
  556. Saves / updates new users.
  557. =cut
  558. sub profile ($query, $render_cb) {
  559. return forbidden($query, $render_cb) unless grep { $_ eq 'admin' } @{$query->{acls}};
  560. #TODO allow users to do something OTHER than be admins
  561. if ($query->{password}) {
  562. Trog::Auth::useradd($query->{username}, $query->{password}, ['admin'] );
  563. }
  564. #Make sure it is "self-authored", redact pw
  565. $query->{user} = delete $query->{username};
  566. delete $query->{password};
  567. return post_save($query, $render_cb);
  568. }
  569. =head2 post_delete
  570. deletes posts.
  571. =cut
  572. sub post_delete ($query, $render_cb) {
  573. return forbidden($query, $render_cb) unless grep { $_ eq 'admin' } @{$query->{acls}};
  574. state $data = Trog::Data->new($conf);
  575. $query->{failure} = $data->delete($query);
  576. $query->{to} = $query->{to};
  577. $query->{message} = $query->{failure} ? "Failed to delete post $query->{id}!" : "Successfully deleted Post $query->{id}";
  578. delete $query->{id};
  579. return posts($query, $render_cb);
  580. }
  581. =head2 series
  582. Series specific view, much like the users/ route
  583. Displays identified series, not all series.
  584. =cut
  585. sub series ($query, $render_cb) {
  586. my $is_admin = grep { $_ eq 'admin' } @{$query->{acls}};
  587. #we are either viewed one of two ways, /post/$id or /$aclname
  588. my (undef,$aclname,$id) = split(/\//,$query->{route});
  589. $query->{aclname} = $aclname if !$id;
  590. $query->{id} = $id if $id;
  591. # Don't show topbar series on the series page. That said, don't exclude it from direct series view.
  592. $query->{exclude_tags} = ['topbar'] if !$is_admin && $aclname && $aclname eq 'series';
  593. #XXX I'd prefer to overload id to actually *be* the aclname...
  594. # but this way, accomodates things like the flat file time-indexing hack.
  595. # TODO I should probably have it for all posts, and make *everything* a series.
  596. # WE can then do threaded comments/posts.
  597. # That will essentially necessitate it *becoming* the ID for real.
  598. #Grab the relevant tag (aclname), then pass that to posts
  599. my @posts = _post_helper($query, ['series'], $query->{acls});
  600. delete $query->{id};
  601. delete $query->{aclname};
  602. $query->{subhead} = $posts[0]->{data};
  603. $query->{title} = $posts[0]->{title};
  604. $query->{tag} = $posts[0]->{aclname};
  605. $query->{primary_post} = $posts[0];
  606. $query->{in_series} = 1;
  607. return posts($query,$render_cb);
  608. }
  609. =head2 avatars
  610. Returns the avatars.css. Limited to 1000 users.
  611. =cut
  612. sub avatars ($query, $render_cb) {
  613. #XXX if you have more than 1000 editors you should stop
  614. push(@{$query->{acls}}, 'public');
  615. my $tags = _coerce_array($query->{tag});
  616. my $processor = Text::Xslate->new(
  617. path => $template_dir,
  618. );
  619. my @posts = _post_helper($query, $tags, $query->{acls});
  620. my $content = $processor->render('avatars.tx', {
  621. users => \@posts,
  622. });
  623. return [200, ["Content-type" => "text/css" ],[$content]];
  624. }
  625. =head2 users
  626. Implements direct user profile view.
  627. =cut
  628. sub users ($query, $render_cb) {
  629. # Capture the username
  630. my (undef, undef, $username) = split(/\//, $query->{route});
  631. $query->{username} //= $username;
  632. push(@{$query->{acls}}, 'public');
  633. $query->{exclude_tags} = ['about'];
  634. # Don't show topbar series on the series page. That said, don't exclude it from direct series view.
  635. my $is_admin = grep { $_ eq 'admin' } @{$query->{acls}};
  636. push(@{$query->{exclude_tags}}, 'topbar') if !$is_admin;
  637. my @posts = _post_helper({ author => $query->{username} }, ['about'], $query->{acls});
  638. $query->{id} = $posts[0]->{id};
  639. $query->{title} = $posts[0]->{title};
  640. $query->{user_obj} = $posts[0];
  641. $query->{primary_post} = $posts[0];
  642. $query->{in_series} = 1;
  643. return posts($query,$render_cb);
  644. }
  645. =head2 posts
  646. Display multi or single posts, supports RSS and pagination.
  647. =cut
  648. sub posts ($query, $render_cb, $direct=0) {
  649. #Process the input URI to capture tag/id
  650. $query->{route} //= $query->{to};
  651. my (undef, undef, $id) = split(/\//, $query->{route});
  652. my $tags = _coerce_array($query->{tag});
  653. $query->{id} = $id if $id && !$query->{in_series};
  654. my $is_admin = grep { $_ eq 'admin' } @{$query->{acls}};
  655. push(@{$query->{acls}}, 'public');
  656. push(@{$query->{acls}}, 'unlisted') if $query->{id};
  657. push(@{$query->{acls}}, 'private') if $is_admin;
  658. my @posts;
  659. # Discover this user's visibility, so we can make them post in this category by default
  660. my $user_visibility = 'public';
  661. if ($query->{user_obj}) {
  662. #Optimize the /users/* route
  663. @posts = ($query->{user_obj});
  664. $user_visibility = $query->{user_obj}->{visibility};
  665. } else {
  666. my @me = _post_helper({ author => $query->{user} }, ['about'], $query->{acls});
  667. $user_visibility = $me[0]->{visibility};
  668. @posts = _post_helper($query, $tags, $query->{acls});
  669. }
  670. if ($query->{id}) {
  671. $query->{primary_post} = $posts[0] if @posts;
  672. }
  673. #OK, so if we have a user as the ID we found, go grab the rest of their posts
  674. if ($query->{id} && @posts && grep { $_ eq 'about'} @{$posts[0]->{tags}} ) {
  675. my $user = shift(@posts);
  676. my $id = delete $query->{id};
  677. $query->{author} = $user->{user};
  678. @posts = _post_helper($query, [], $query->{acls});
  679. @posts = grep { $_->{id} ne $id } @posts;
  680. unshift @posts, $user;
  681. }
  682. if (!$is_admin) {
  683. return notfound($query, $render_cb) unless @posts;
  684. }
  685. my $fmt = $query->{format} || '';
  686. return _rss($query,\@posts) if $fmt eq 'rss';
  687. my $processor = Text::Xslate->new(
  688. path => $template_dir,
  689. function => {
  690. render_it => sub {
  691. my ($template_string, $options) = @_;
  692. return Text::Xslate->new(
  693. # Prevent a recursive descent. If the renderer is hit again, just do nothing
  694. # XXX unfortunately if the post tries to include itself, it will die.
  695. function => {
  696. embed => sub {
  697. my ($this_id, $style) = @_;
  698. $style //= 'embed';
  699. # If instead the style is 'content', then we will only show the content w/ no formatting, and no title.
  700. return Text::Xslate::mark_raw(Trog::Routes::HTML::posts(
  701. { route => "/post/$this_id", style => $style },
  702. sub {},
  703. 1));
  704. },
  705. },
  706. )->render_string($template_string,$options);
  707. },
  708. },
  709. );
  710. #XXX Is used by the sitemap, maybe just fix there?
  711. my @post_aliases = map { $_->{local_href} } _get_series();
  712. my ($header,$footer);
  713. my $should_header = grep { $_ eq $query->{route} } (@post_aliases,'/humans.txt');
  714. if ($should_header) {
  715. my $route = $query->{route};
  716. my %alias = ( '/humans.txt' => '/about');
  717. $route = $alias{$route} if exists $alias{$route};
  718. my $t_processor;
  719. $t_processor = Text::Xslate->new(
  720. path => "www/$theme_dir/templates",
  721. ) if $theme_dir;
  722. my $no_leading_slash = $route;
  723. $no_leading_slash =~ tr/\///d;
  724. $header = _pick_processor("templates$route\_header.tx" ,$processor,$t_processor)->render("$no_leading_slash\_header.tx", { theme_dir => $td } );
  725. $footer = _pick_processor("templates$route\_header.tx" ,$processor,$t_processor)->render("$no_leading_slash\_footer.tx", { theme_dir => $td } );
  726. }
  727. my $styles = _build_themed_styles('posts.css');
  728. #Correct page headers
  729. my $ph = $themed ? _themed_title($query->{route}) : $query->{route};
  730. # Build page title if it wasn't set by a wrapping sub
  731. $query->{title} = "$query->{domain} : $query->{title}" if $query->{title} && $query->{domain};
  732. $query->{title} ||= @$tags && $query->{domain} ? "$query->{domain} : @$tags" : undef;
  733. #Handle paginator vars
  734. my $limit = int($query->{limit} || 25);
  735. my $now_year = (localtime(time))[5] + 1900;
  736. my $oldest_year = $now_year - 20; #XXX actually find oldest post year
  737. # Handle post style.
  738. if ($query->{style}) {
  739. undef $header;
  740. undef $footer;
  741. }
  742. my $older = !@posts ? 0 : $posts[-1]->{created};
  743. $query->{failure} //= -1;
  744. $query->{id} //= '';
  745. #XXX messed up data has to be fixed unfortunately
  746. @$tags = List::Util::uniq @$tags;
  747. #XXX also unsure this is actually necessary
  748. my $app = 'file';
  749. if ($query->{route}) {
  750. $app = 'image' if $query->{route} =~ m/image$/;
  751. $app = 'video' if $query->{route} =~ m/video$/;
  752. $app = 'audio' if $query->{route} =~ m/audio$/;
  753. }
  754. #Filter displaying visibility tags
  755. my @visibuddies = qw{public unlisted private};
  756. foreach my $post (@posts) {
  757. @{$post->{tags}} = grep { my $tag = $_; !grep { $tag eq $_ } @visibuddies } @{$post->{tags}};
  758. }
  759. my $aclselected = $tags->[0] || '';
  760. my @acls = map {
  761. $_->{selected} = $_->{aclname} eq $aclselected ? 'selected' : '';
  762. $_
  763. } _post_helper({}, ['series'], $query->{acls});
  764. #TODO make this dynamic with a template subdirectory for users to plop things in
  765. my $forms = [qw{microblog.tx blog.tx file.tx}];
  766. my $edittype = $query->{primary_post} ? $query->{primary_post}->{child_form} : $query->{form};
  767. my $content = $processor->render('posts.tx', {
  768. app => $app,
  769. acls => \@acls,
  770. can_edit => $is_admin,
  771. edittype => $edittype,
  772. forms => $forms,
  773. post => { tags => $tags, form => $edittype, visibility => $user_visibility },
  774. post_visibilities => \@visibuddies,
  775. failure => $query->{failure},
  776. to => $query->{to},
  777. message => $query->{failure} ? "Failed to add post!" : "Successfully added Post as $query->{id}",
  778. direct => $direct,
  779. title => $query->{title},
  780. style => $query->{style},
  781. posts => \@posts,
  782. like => $query->{like},
  783. in_series => exists $query->{in_series} || !!($query->{route} =~ m/^\/series\//),
  784. route => $query->{route},
  785. limit => $limit,
  786. pages => scalar(@posts) == $limit,
  787. older => $older,
  788. sizes => [25,50,100],
  789. rss => !$query->{id} && !$query->{older},
  790. tiled => !$is_admin && scalar(grep { $_ eq $query->{route} } qw{/files /audio /video /image /series /about}),
  791. category => $ph,
  792. subhead => $query->{subhead},
  793. header => $header,
  794. footer => $footer,
  795. years => [reverse($oldest_year..$now_year)],
  796. months => [0..11],
  797. });
  798. return $content if $direct;
  799. return Trog::Routes::HTML::index($query, $render_cb, $content, $styles);
  800. }
  801. sub _themed_title ($path) {
  802. return $path unless %Theme::paths;
  803. return $Theme::paths{$path} ? $Theme::paths{$path} : $path;
  804. }
  805. sub _post_helper ($query, $tags, $acls) {
  806. state $data = Trog::Data->new($conf);
  807. return $data->get(
  808. older => $query->{older},
  809. page => int($query->{page} || 1),
  810. limit => int($query->{limit} || 25),
  811. tags => $tags,
  812. exclude_tags => $query->{exclude_tags},
  813. acls => $acls,
  814. aclname => $query->{aclname},
  815. like => $query->{like},
  816. author => $query->{author},
  817. id => $query->{id},
  818. version => $query->{version},
  819. );
  820. }
  821. =head2 sitemap
  822. Return the sitemap index unless the static or a set of dynamic routes is requested.
  823. We have a maximum of 99,990,000 posts we can make under this model
  824. As we have 10,000 * 10,000 posts which are indexable via the sitemap format.
  825. 1 top level index slot (10k posts) is taken by our static routes, the rest will be /posts.
  826. Passing ?xml=1 will result in an appropriate sitemap.xml instead.
  827. This is used to generate the static sitemaps as expected by search engines.
  828. Passing compressed=1 will gzip the output.
  829. =cut
  830. sub sitemap ($query, $render_cb) {
  831. my (@to_map, $is_index, $route_type);
  832. my $warning = '';
  833. $query->{map} //= '';
  834. if ($query->{map} eq 'static') {
  835. # Return the map of static routes
  836. $route_type = 'Static Routes';
  837. @to_map = grep { !defined $routes{$_}->{captures} && $_ !~ m/^default|login|auth$/ && !$routes{$_}->{auth} } keys(%routes);
  838. } elsif ( !$query->{map} ) {
  839. # Return the index instead
  840. @to_map = ('static');
  841. my $data = Trog::Data->new($conf);
  842. my $tot = $data->count();
  843. my $size = 50000;
  844. my $pages = int($tot / $size) + (($tot % $size) ? 1 : 0);
  845. # Truncate pages at 10k due to standard
  846. my $clamped = $pages > 49999 ? 49999 : $pages;
  847. $warning = "More posts than possible to represent in sitemaps & index! Old posts have been truncated." if $pages > 49999;
  848. foreach my $page ($clamped..1) {
  849. push(@to_map, "$page");
  850. }
  851. $is_index = 1;
  852. } else {
  853. $route_type = "Posts: Page $query->{map}";
  854. # Return the map of the particular range of dynamic posts
  855. $query->{limit} = 50000;
  856. $query->{page} = $query->{map};
  857. @to_map = _post_helper($query, [], ['public']);
  858. }
  859. if ( $query->{xml} ) {
  860. my $sm;
  861. my $xml_date = time();
  862. my $fmt = "xml";
  863. $fmt .= ".gz" if $query->{compressed};
  864. if ( !$query->{map}) {
  865. require WWW::SitemapIndex::XML;
  866. $sm = WWW::SitemapIndex::XML->new();
  867. foreach my $url (@to_map) {
  868. $sm->add(
  869. loc => "http://$query->{domain}/sitemap/$url.$fmt",
  870. lastmod => $xml_date,
  871. );
  872. }
  873. } else {
  874. require WWW::Sitemap::XML;
  875. $sm = WWW::Sitemap::XML->new();
  876. my $changefreq = $query->{map} eq 'static' ? 'monthly' : 'daily';
  877. foreach my $url (@to_map) {
  878. my $true_uri = "http://$query->{domain}$url";
  879. if (ref $url eq 'HASH') {
  880. my $is_user_page = grep { $_ eq 'about' } @{$url->{tags}};
  881. $true_uri = "http://$query->{domain}/posts/$url->{id}";
  882. $true_uri = "http://$query->{domain}/users/$url->{title}" if $is_user_page;
  883. }
  884. my %data = (
  885. loc => $true_uri,
  886. lastmod => $xml_date,
  887. mobile => 1,
  888. changefreq => $changefreq,
  889. priority => 1.0,
  890. );
  891. if (ref $url eq 'HASH') {
  892. #add video & preview image if applicable
  893. $data{images} = [{
  894. loc => "http://$query->{domain}$url->{href}",
  895. caption => $url->{data},
  896. title => substr($url->{title},0,100),
  897. }] if $url->{is_image};
  898. # Truncate descriptions
  899. my $desc = substr($url->{data},0,2048);
  900. $data{videos} = [{
  901. content_loc => "http://$query->{domain}$url->{href}",
  902. thumbnail_loc => "http://$query->{domain}$url->{preview}",
  903. title => substr($url->{title},0,100),
  904. description => $desc,
  905. }] if $url->{is_video};
  906. }
  907. $sm->add(%data);
  908. }
  909. }
  910. my $xml = $sm->as_xml();
  911. require IO::String;
  912. my $buf = IO::String->new();
  913. my $ct = 'application/xml';
  914. $xml->toFH($buf, 0);
  915. seek $buf, 0, 0;
  916. if ($query->{compressed}) {
  917. require IO::Compress::Gzip;
  918. my $compressed = IO::String->new();
  919. IO::Compress::Gzip::gzip($buf => $compressed);
  920. $ct = 'application/gzip';
  921. $buf = $compressed;
  922. seek $compressed, 0, 0;
  923. }
  924. return [200,["Content-type" => $ct], $buf];
  925. }
  926. @to_map = sort @to_map unless $is_index;
  927. my $processor = Text::Xslate->new(
  928. path => _dir_for_resource('sitemap.tx'),
  929. );
  930. my $styles = _build_themed_styles('sitemap.css');
  931. $query->{title} = "$query->{domain} : Sitemap";
  932. my $content = $processor->render('sitemap.tx', {
  933. title => "Site Map",
  934. to_map => \@to_map,
  935. is_index => $is_index,
  936. route_type => $route_type,
  937. route => $query->{route},
  938. });
  939. return Trog::Routes::HTML::index($query, $render_cb,$content,$styles);
  940. }
  941. sub _rss ($query,$posts) {
  942. require XML::RSS;
  943. my $rss = XML::RSS->new (version => '2.0');
  944. my $now = DateTime->from_epoch(epoch => time());
  945. $rss->channel(
  946. title => "$query->{domain}",
  947. link => "http://$query->{domain}/$query->{route}?format=rss",
  948. language => 'en', #TODO localization
  949. description => "$query->{domain} : $query->{route}",
  950. pubDate => $now,
  951. lastBuildDate => $now,
  952. );
  953. #TODO configurability
  954. $rss->image(
  955. title => $query->{domain},
  956. url => "$td/img/icon/favicon.ico",
  957. link => "http://$query->{domain}",
  958. width => 88,
  959. height => 31,
  960. description => "$query->{domain} favicon",
  961. );
  962. foreach my $post (@$posts) {
  963. my $url = "http://$query->{domain}$post->{local_href}";
  964. _post2rss($rss,$url,$post);
  965. next unless ref $post->{aliases} eq 'ARRAY';
  966. foreach my $alias (@{$post->{aliases}}) {
  967. $url = "http://$query->{domain}$alias";
  968. _post2rss($rss,$url,$post);
  969. }
  970. }
  971. require Encode;
  972. return [200, ["Content-type" => "application/rss+xml"], [Encode::encode_utf8($rss->as_string)]];
  973. }
  974. sub _post2rss ($rss,$url,$post) {
  975. $rss->add_item(
  976. title => $post->{title},
  977. permaLink => $url,
  978. link => $url,
  979. enclosure => { url => $url, type=>"text/html" },
  980. description => "<![CDATA[$post->{data}]]>",
  981. pubDate => DateTime->from_epoch(epoch => $post->{created} ), #TODO format like Thu, 23 Aug 1999 07:00:00 GMT
  982. author => $post->{user}, #TODO translate to "email (user)" format
  983. );
  984. }
  985. =head2 manual
  986. Implements the /manual and /lib/* routes.
  987. Basically a thin wrapper around Pod::Html.
  988. =cut
  989. sub manual ($query, $render_cb) {
  990. require Pod::Html;
  991. require Capture::Tiny;
  992. return forbidden($query, $render_cb) unless grep { $_ eq 'admin' } @{$query->{acls}};
  993. #Fix links from Pod::HTML
  994. $query->{module} =~ s/\.html$//g if $query->{module};
  995. my $infile = $query->{module} ? "$query->{module}.pm" : 'tCMS/Manual.pod';
  996. return notfound($query,$render_cb) unless -f "lib/$infile";
  997. my $content = capture { Pod::Html::pod2html(qw{--podpath=lib --podroot=.},"--infile=lib/$infile") };
  998. my @series = _get_series(1);
  999. return $render_cb->('manual.tx', {
  1000. title => 'tCMS Manual',
  1001. theme_dir => $td,
  1002. content => $content,
  1003. categories => \@series,
  1004. stylesheets => _build_themed_styles('post.css'),
  1005. });
  1006. }
  1007. # Deal with Params which may or may not be arrays
  1008. sub _coerce_array ($param) {
  1009. my $p = $param || [];
  1010. $p = [$param] if $param && (ref $param ne 'ARRAY');
  1011. return $p;
  1012. }
  1013. sub _build_themed_styles ($style) {
  1014. my @styles;
  1015. @styles = ("/styles/$style") if -f "www/styles/$style";
  1016. my $ts = _themed_style($style);
  1017. push(@styles, $ts) if $theme_dir && -f "www/$ts";
  1018. return \@styles;
  1019. }
  1020. sub _build_themed_scripts ($script) {
  1021. my @scripts = ("/scripts/$script");
  1022. my $ts = _themed_style($script);
  1023. push(@scripts, $ts) if $theme_dir && -f "www/$ts";
  1024. return \@scripts;
  1025. }
  1026. sub _pick_processor($file, $normal, $themed) {
  1027. return _dir_for_resource($file) eq $template_dir ? $normal : $themed;
  1028. }
  1029. # Pick appropriate dir based on whether theme override exists
  1030. sub _dir_for_resource ($resource) {
  1031. return $theme_dir && -f "www/$theme_dir/$resource" ? $theme_dir : $template_dir;
  1032. }
  1033. sub _themed_style ($resource) {
  1034. return _dir_for_resource("styles/$resource")."/styles/$resource";
  1035. }
  1036. sub _themed_script ($resource) {
  1037. return _dir_for_resource("scripts/$resource")."/scripts/$resource";
  1038. }
  1039. 1;