HTML.pm 36 KB

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