| 12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273 |
- #!/usr/bin/env perl
- use v5.36;
- use re '/aa';
- use FindBin::libs;
- use Trog::Config();
- use Getopt::Long qw{GetOptionsFromArray};
- =head1 SYNOPSIS
- Get, or set, the hostname this tCMS instance serves.
- Everything which needs to know the site's domain -- TOTP enrollment, the DNS
- zone, generated URLs -- reads it out of the configuration, so this is where it
- gets put there in the first place.
- =head2 USAGE
- bin/tcms-hostname # print the configured hostname
- bin/tcms-hostname example.com # set it, then print it
- bin/tcms-hostname --user # print it as a valid username
- =head2 OPTIONS
- =over 4
- =item --user
- Print the hostname mangled into something usable as a system username: dots
- become dashes, and it's truncated to 32 characters. Does not change what is
- stored in the configuration.
- =back
- =head2 CAVEATS
- Writes to $Trog::Config::home_cfg rather than saving over whatever get()
- loaded, as that is the tracked config/default.cfg until the instance has a
- configuration of its own.
- Dies if asked to print a hostname which was never set.
- =cut
- my $user;
- GetOptionsFromArray(\@ARGV,
- 'user' => \$user,
- );
- my $hostname = $ARGV[0];
- my $conf = Trog::Config->get();
- if ($hostname) {
- $conf->param('general.hostname', $hostname);
- # write(), not save(). save() writes back to whatever file get() loaded,
- # which is the tracked config/default.cfg until the instance has saved a
- # configuration of its own.
- $conf->write($Trog::Config::home_cfg) or die "Could not write $Trog::Config::home_cfg";
- }
- my $domain = $conf->param('general.hostname');
- die "Hostname not set in tCMS configuration. Please set this first by passing the hostname to bin/tcms-hostname." unless $domain;
- # Transform the domain name into something maximally compatible with being a username.
- if ($user) {
- $domain = substr($domain, 0, 32);
- $domain =~ s/\./-/g;
- }
- print "$domain\n";
|