tcms-hostname 1.9 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273
  1. #!/usr/bin/env perl
  2. use strict;
  3. use warnings;
  4. use FindBin::libs;
  5. use Trog::Config();
  6. use Getopt::Long qw{GetOptionsFromArray};
  7. =head1 SYNOPSIS
  8. Get, or set, the hostname this tCMS instance serves.
  9. Everything which needs to know the site's domain -- TOTP enrollment, the DNS
  10. zone, generated URLs -- reads it out of the configuration, so this is where it
  11. gets put there in the first place.
  12. =head2 USAGE
  13. bin/tcms-hostname # print the configured hostname
  14. bin/tcms-hostname example.com # set it, then print it
  15. bin/tcms-hostname --user # print it as a valid username
  16. =head2 OPTIONS
  17. =over 4
  18. =item --user
  19. Print the hostname mangled into something usable as a system username: dots
  20. become dashes, and it's truncated to 32 characters. Does not change what is
  21. stored in the configuration.
  22. =back
  23. =head2 CAVEATS
  24. Writes to $Trog::Config::home_cfg rather than saving over whatever get()
  25. loaded, as that is the tracked config/default.cfg until the instance has a
  26. configuration of its own.
  27. Dies if asked to print a hostname which was never set.
  28. =cut
  29. my $user;
  30. GetOptionsFromArray(\@ARGV,
  31. 'user' => \$user,
  32. );
  33. my $hostname = $ARGV[0];
  34. my $conf = Trog::Config->get();
  35. if ($hostname) {
  36. $conf->param('general.hostname', $hostname);
  37. # write(), not save(). save() writes back to whatever file get() loaded,
  38. # which is the tracked config/default.cfg until the instance has saved a
  39. # configuration of its own.
  40. $conf->write($Trog::Config::home_cfg) or die "Could not write $Trog::Config::home_cfg";
  41. }
  42. my $domain = $conf->param('general.hostname');
  43. die "Hostname not set in tCMS configuration. Please set this first by passing the hostname to bin/tcms-hostname." unless $domain;
  44. # Transform the domain name into something maximally compatible with being a username.
  45. if ($user) {
  46. $domain = substr($domain, 0, 32);
  47. $domain =~ s/\./-/g;
  48. }
  49. print "$domain\n";