2010-04-27 13:29:08 +00:00
package Hydra::Controller::Admin ;
use strict ;
use warnings ;
use base 'Catalyst::Controller' ;
use Hydra::Helper::Nix ;
use Hydra::Helper::CatalystUtils ;
2010-05-18 11:37:01 +00:00
use Hydra::Helper::AddBuilds ;
2010-10-13 12:32:57 +00:00
use Data::Dump qw( dump ) ;
2010-12-03 09:40:25 +00:00
use Digest::SHA1 qw( sha1_hex ) ;
use Crypt::RandPasswd ;
use Sys::Hostname::Long ;
use Email::Simple ;
use Email::Sender::Simple qw( sendmail ) ;
use Email::Sender::Transport::SMTP ;
2012-01-28 21:03:44 +01:00
use Config::General ;
2010-10-13 12:32:57 +00:00
2012-04-17 16:53:11 +02:00
2010-10-13 12:32:57 +00:00
sub nixMachines {
my ( $ c ) = @ _ ;
2010-10-18 11:05:36 +00:00
my $ result = "# GENERATED BY HYDRA\n" ;
2011-04-01 07:40:06 +00:00
2010-10-13 12:32:57 +00:00
foreach my $ machine ( $ c - > model ( "DB::BuildMachines" ) - > all ) {
if ( $ machine - > enabled ) {
$ result = $ result . $ machine - > username . '@' . $ machine - > hostname . ' ' ;
foreach my $ system ( $ machine - > buildmachinesystemtypes ) {
$ result = $ result . $ system - > system . ',' ;
}
chop $ result ;
$ result = $ result . ' ' . $ machine - > ssh_key . ' ' . $ machine - > maxconcurrent . ' ' . $ machine - > speedfactor . ' ' . $ machine - > options . "\n" ;
}
}
return $ result ;
}
2012-04-17 16:53:11 +02:00
2010-10-13 12:32:57 +00:00
sub saveNixMachines {
my ( $ c ) = @ _ ;
die ( "File not writable: /etc/nix.machines" ) if ! - w "/etc/nix.machines" ;
open ( NIXMACHINES , '>/etc/nix.machines' ) or die ( "Could not write to /etc/nix.machines" ) ;
print NIXMACHINES nixMachines ( $ c ) ;
2011-04-01 07:40:06 +00:00
close ( NIXMACHINES ) ;
2010-10-13 12:32:57 +00:00
}
2010-04-27 14:11:08 +00:00
2012-04-17 16:53:11 +02:00
2010-04-27 14:11:08 +00:00
sub admin : Chained('/') PathPart('admin') CaptureArgs(0) {
2010-04-27 13:29:08 +00:00
my ( $ self , $ c ) = @ _ ;
requireAdmin ( $ c ) ;
2010-10-13 12:32:57 +00:00
$ c - > stash - > { admin } = 1 ;
2010-04-27 14:11:08 +00:00
}
2010-04-27 13:29:08 +00:00
2012-04-17 16:53:11 +02:00
2010-04-27 14:11:08 +00:00
sub index : Chained('admin') PathPart('') Args(0) {
my ( $ self , $ c ) = @ _ ;
2010-10-13 12:32:57 +00:00
$ c - > stash - > { machines } = [ $ c - > model ( 'DB::BuildMachines' ) - > search (
2011-04-01 07:40:06 +00:00
{ } ,
2010-10-21 14:37:03 +00:00
{ order_by = > [ "enabled DESC" , "hostname" ]
2010-10-13 12:32:57 +00:00
, '+select' = > [ "(select bs.stoptime from buildsteps as bs where bs.machine = (me.username || '\@' || me.hostname) and not bs.stoptime is null order by bs.stoptime desc limit 1)" ]
, '+as' = > [ 'idle' ]
} ) ] ;
$ c - > stash - > { steps } = [ $ c - > model ( 'DB::BuildSteps' ) - > search (
2012-02-29 02:22:49 +01:00
{ finished = > 0 , 'me.busy' = > 1 , 'build.busy' = > 1 , } ,
{ join = > [ 'build' ]
, order_by = > [ 'machine' , 'stepnr' ]
2010-10-13 12:32:57 +00:00
} ) ] ;
2010-04-27 13:29:08 +00:00
$ c - > stash - > { template } = 'admin.tt' ;
2012-04-17 16:53:11 +02:00
}
2011-04-01 07:40:06 +00:00
2010-12-03 09:40:25 +00:00
sub updateUser {
my ( $ c , $ user ) = @ _ ;
my $ username = trim $ c - > request - > params - > { "username" } ;
my $ fullname = trim $ c - > request - > params - > { "fullname" } ;
my $ emailaddress = trim $ c - > request - > params - > { "emailaddress" } ;
my $ emailonerror = trim $ c - > request - > params - > { "emailonerror" } ;
2011-04-01 07:40:06 +00:00
my $ roles = $ c - > request - > params - > { "roles" } ;
2010-12-03 09:40:25 +00:00
$ user - > update (
2011-03-07 16:46:46 +00:00
{ fullname = > $ fullname
2010-12-03 09:40:25 +00:00
, emailaddress = > $ emailaddress
, emailonerror = > $ emailonerror
} ) ;
$ user - > userroles - > delete_all ;
if ( ref ( $ roles ) eq 'ARRAY' ) {
for my $ s ( @$ roles ) {
$ user - > userroles - > create ( { role = > $ s } ) ;
2011-04-01 07:40:06 +00:00
}
2010-12-03 09:40:25 +00:00
} else {
2011-03-15 14:57:05 +00:00
$ user - > userroles - > create ( { role = > $ roles } ) if defined $ roles ;
2011-04-01 07:40:06 +00:00
}
2010-12-03 09:40:25 +00:00
}
2012-04-17 16:53:11 +02:00
sub create_user : Chained('admin') PathPart('create-user') Args(0) {
my ( $ self , $ c ) = @ _ ;
requireAdmin ( $ c ) ;
2012-08-06 00:02:14 +02:00
$ c - > stash - > { template } = 'user.tt' ;
$ c - > stash - > { edit } = 1 ;
$ c - > stash - > { create } = 1 ;
}
sub create_user_submit : Chained('admin') PathPart('create-user/submit') Args(0) {
my ( $ self , $ c ) = @ _ ;
my $ username = trim $ c - > request - > params - > { username } ;
txn_do ( $ c - > model ( 'DB' ) - > schema , sub {
my $ user = $ c - > model ( 'DB::Users' ) - > create (
{ username = > $ username , emailaddress = > "" , password = > "" } ) ;
updateUser ( $ c , $ user ) ;
} ) ;
$ c - > res - > redirect ( "/admin/users" ) ;
2012-04-17 16:53:11 +02:00
}
2012-08-06 00:02:14 +02:00
2010-12-03 09:40:25 +00:00
sub user : Chained('admin') PathPart('user') CaptureArgs(1) {
my ( $ self , $ c , $ username ) = @ _ ;
requireAdmin ( $ c ) ;
my $ user = $ c - > model ( 'DB::Users' ) - > find ( $ username )
or notFound ( $ c , "User $username doesn't exist." ) ;
$ c - > stash - > { user } = $ user ;
}
2012-04-17 16:53:11 +02:00
2010-12-03 09:40:25 +00:00
sub users : Chained('admin') PathPart('users') Args(0) {
my ( $ self , $ c ) = @ _ ;
$ c - > stash - > { users } = [ $ c - > model ( 'DB::Users' ) - > search ( { } , { order_by = > "username" } ) ] ;
$ c - > stash - > { template } = 'users.tt' ;
}
2012-04-17 16:53:11 +02:00
2010-12-03 09:40:25 +00:00
sub user_edit : Chained('user') PathPart('edit') Args(0) {
my ( $ self , $ c ) = @ _ ;
$ c - > stash - > { template } = 'user.tt' ;
$ c - > stash - > { edit } = 1 ;
}
2012-04-17 16:53:11 +02:00
2010-12-03 09:40:25 +00:00
sub user_edit_submit : Chained('user') PathPart('submit') Args(0) {
my ( $ self , $ c ) = @ _ ;
requirePost ( $ c ) ;
txn_do ( $ c - > model ( 'DB' ) - > schema , sub {
2012-04-17 16:53:11 +02:00
if ( ( $ c - > request - > params - > { submit } || "" ) eq "delete" ) {
$ c - > stash - > { user } - > delete ;
} else {
updateUser ( $ c , $ c - > stash - > { user } ) ;
}
2010-12-03 09:40:25 +00:00
} ) ;
2012-04-17 16:53:11 +02:00
2010-12-03 09:40:25 +00:00
$ c - > res - > redirect ( "/admin/users" ) ;
}
2012-04-17 16:53:11 +02:00
2010-12-03 09:40:25 +00:00
sub sendemail {
2011-04-01 07:40:06 +00:00
my ( $ to , $ subject , $ body ) = @ _ ;
2010-12-03 09:40:25 +00:00
my $ url = hostname_long ;
my $ sender = ( $ ENV { 'USER' } || "hydra" ) . "@" . $ url ;
2011-04-01 07:40:06 +00:00
2010-12-03 09:40:25 +00:00
my $ email = Email::Simple - > create (
header = > [
To = > $ to ,
From = > "Hydra <$sender>" ,
Subject = > $ subject
] ,
body = > $ body
) ;
sendmail ( $ email ) ;
}
2012-04-17 16:53:11 +02:00
2010-12-03 09:40:25 +00:00
sub reset_password : Chained('user') PathPart('reset-password') Args(0) {
my ( $ self , $ c ) = @ _ ;
# generate password
my $ password = Crypt::RandPasswd - > word ( 8 , 10 ) ;
2011-04-01 07:40:06 +00:00
2010-12-03 09:40:25 +00:00
# calculate hash
my $ hashed = sha1_hex ( $ password ) ;
$ c - > stash - > { user } - > update ( { password = > $ hashed } ) ;
# send email
sendemail (
2012-01-28 07:14:40 +01:00
$ c - > stash - > { user } - > emailaddress ,
2010-12-03 09:40:25 +00:00
"New password for Hydra" ,
"Hi,\n\n" .
"Your password has been reset. Your new password is '$password'.\n" .
2013-01-22 14:06:12 +01:00
"You can change your password at " . $ c - > config ( ) - > { 'base_uri' } . "/change-password .\n" .
2010-12-03 09:40:25 +00:00
"With regards, Hydra\n"
) ;
$ c - > res - > redirect ( "/admin/users" ) ;
}
2010-10-13 12:32:57 +00:00
2012-04-17 16:53:11 +02:00
2010-10-13 12:32:57 +00:00
sub machines : Chained('admin') PathPart('machines') Args(0) {
my ( $ self , $ c ) = @ _ ;
$ c - > stash - > { machines } = [ $ c - > model ( 'DB::BuildMachines' ) - > search ( { } , { order_by = > "hostname" } ) ] ;
$ c - > stash - > { systems } = [ $ c - > model ( 'DB::SystemTypes' ) - > search ( { } , { select = > [ "system" ] , order_by = > "system" } ) ] ;
$ c - > stash - > { nixMachines } = nixMachines ( $ c ) ;
$ c - > stash - > { nixMachinesWritable } = ( - e "/etc/nix.machines" && - w "/etc/nix.machines" ) ;
$ c - > stash - > { template } = 'machines.tt' ;
2012-04-17 16:53:11 +02:00
}
2010-10-13 12:32:57 +00:00
sub machine : Chained('admin') PathPart('machine') CaptureArgs(1) {
my ( $ self , $ c , $ machineName ) = @ _ ;
requireAdmin ( $ c ) ;
my $ machine = $ c - > model ( 'DB::BuildMachines' ) - > find ( $ machineName )
or notFound ( $ c , "Machine $machineName doesn't exist." ) ;
$ c - > stash - > { machine } = $ machine ;
}
2012-04-17 16:53:11 +02:00
2010-10-13 12:32:57 +00:00
sub machine_edit : Chained('machine') PathPart('edit') Args(0) {
my ( $ self , $ c ) = @ _ ;
$ c - > stash - > { template } = 'machine.tt' ;
$ c - > stash - > { systemtypes } = [ $ c - > model ( 'DB::SystemTypes' ) - > search ( { } , { order_by = > "system" } ) ] ;
$ c - > stash - > { edit } = 1 ;
}
2012-04-17 16:53:11 +02:00
2010-10-13 12:32:57 +00:00
sub machine_edit_submit : Chained('machine') PathPart('submit') Args(0) {
my ( $ self , $ c ) = @ _ ;
requirePost ( $ c ) ;
txn_do ( $ c - > model ( 'DB' ) - > schema , sub {
2012-04-17 16:53:11 +02:00
if ( ( $ c - > request - > params - > { submit } || "" ) eq "delete" ) {
$ c - > stash - > { machine } - > delete ;
} else {
updateMachine ( $ c , $ c - > stash - > { machine } ) ;
}
2010-10-13 12:32:57 +00:00
} ) ;
2012-04-17 16:53:11 +02:00
2010-10-13 12:32:57 +00:00
saveNixMachines ( $ c ) ;
2012-04-17 16:53:11 +02:00
2010-10-13 12:32:57 +00:00
$ c - > res - > redirect ( "/admin/machines" ) ;
}
2012-04-17 16:53:11 +02:00
2010-10-13 12:32:57 +00:00
sub updateMachine {
2012-04-17 16:53:11 +02:00
my ( $ c , $ machine ) = @ _ ;
2010-10-13 12:32:57 +00:00
my $ hostname = trim $ c - > request - > params - > { "hostname" } ;
my $ username = trim $ c - > request - > params - > { "username" } ;
my $ maxconcurrent = trim $ c - > request - > params - > { "maxconcurrent" } ;
my $ speedfactor = trim $ c - > request - > params - > { "speedfactor" } ;
my $ ssh_key = trim $ c - > request - > params - > { "ssh_key" } ;
2010-10-13 12:35:34 +00:00
my $ options = trim $ c - > request - > params - > { "options" } ;
2011-04-01 07:40:06 +00:00
my $ systems = $ c - > request - > params - > { "systems" } ;
2010-10-13 12:32:57 +00:00
error ( $ c , "Invalid or empty username." ) if $ username eq "" ;
error ( $ c , "Max concurrent builds should be an integer > 0." ) if $ maxconcurrent eq "" || ! $ maxconcurrent =~ m/[0-9]+/ ;
error ( $ c , "Speed factor should be an integer > 0." ) if $ speedfactor eq "" || ! $ speedfactor =~ m/[0-9]+/ ;
error ( $ c , "Invalid or empty SSH key." ) if $ ssh_key eq "" ;
2011-04-01 07:40:06 +00:00
2010-10-13 12:32:57 +00:00
$ machine - > update (
{ username = > $ username
, maxconcurrent = > $ maxconcurrent
, speedfactor = > $ speedfactor
, ssh_key = > $ ssh_key
2010-10-13 12:35:34 +00:00
, options = > $ options
2010-10-13 12:32:57 +00:00
} ) ;
$ machine - > buildmachinesystemtypes - > delete_all ;
if ( ref ( $ systems ) eq 'ARRAY' ) {
for my $ s ( @$ systems ) {
$ machine - > buildmachinesystemtypes - > create ( { system = > $ s } ) ;
2011-04-01 07:40:06 +00:00
}
2010-10-13 12:32:57 +00:00
} else {
$ machine - > buildmachinesystemtypes - > create ( { system = > $ systems } ) ;
2011-04-01 07:40:06 +00:00
}
2010-10-13 12:32:57 +00:00
}
2012-04-17 16:53:11 +02:00
2010-10-13 12:32:57 +00:00
sub create_machine : Chained('admin') PathPart('create-machine') Args(0) {
my ( $ self , $ c ) = @ _ ;
requireAdmin ( $ c ) ;
2011-04-01 07:40:06 +00:00
2010-10-13 12:32:57 +00:00
$ c - > stash - > { template } = 'machine.tt' ;
$ c - > stash - > { systemtypes } = [ $ c - > model ( 'DB::SystemTypes' ) - > search ( { } , { order_by = > "system" } ) ] ;
$ c - > stash - > { edit } = 1 ;
$ c - > stash - > { create } = 1 ;
}
sub create_machine_submit : Chained('admin') PathPart('create-machine/submit') Args(0) {
my ( $ self , $ c ) = @ _ ;
requireAdmin ( $ c ) ;
2011-04-01 07:40:06 +00:00
2010-10-13 12:51:29 +00:00
my $ hostname = trim $ c - > request - > params - > { "hostname" } ;
2010-10-13 12:32:57 +00:00
error ( $ c , "Invalid or empty hostname." ) if $ hostname eq "" ;
2011-04-01 07:40:06 +00:00
2010-10-13 12:32:57 +00:00
txn_do ( $ c - > model ( 'DB' ) - > schema , sub {
my $ machine = $ c - > model ( 'DB::BuildMachines' ) - > create (
{ hostname = > $ hostname } ) ;
2010-10-13 12:51:29 +00:00
updateMachine ( $ c , $ machine ) ;
2010-10-13 12:32:57 +00:00
} ) ;
2010-10-13 12:51:29 +00:00
saveNixMachines ( $ c ) ;
2010-10-13 12:32:57 +00:00
$ c - > res - > redirect ( "/admin/machines" ) ;
}
sub machine_enable : Chained('machine') PathPart('enable') Args(0) {
my ( $ self , $ c ) = @ _ ;
$ c - > stash - > { machine } - > update ( { enabled = > 1 } ) ;
saveNixMachines ( $ c ) ;
$ c - > res - > redirect ( "/admin/machines" ) ;
}
sub machine_disable : Chained('machine') PathPart('disable') Args(0) {
my ( $ self , $ c ) = @ _ ;
$ c - > stash - > { machine } - > update ( { enabled = > 0 } ) ;
saveNixMachines ( $ c ) ;
$ c - > res - > redirect ( "/admin/machines" ) ;
2010-04-27 13:29:08 +00:00
}
2012-04-17 16:53:11 +02:00
2012-02-16 15:31:12 +01:00
sub clear_queue_non_current : Chained('admin') Path('clear-queue-non-current') Args(0) {
my ( $ self , $ c ) = @ _ ;
2012-04-30 22:13:53 +02:00
$ c - > model ( 'DB::Builds' ) - > search ( { finished = > 0 , iscurrent = > 0 , busy = > 0 } ) - > update ( { finished = > 1 , buildstatus = > 4 , timestamp = > time } ) ;
2012-02-16 15:31:12 +01:00
$ c - > res - > redirect ( "/admin" ) ;
}
2012-04-17 16:53:11 +02:00
2010-04-27 14:11:08 +00:00
sub clearfailedcache : Chained('admin') Path('clear-failed-cache') Args(0) {
2010-04-27 13:29:08 +00:00
my ( $ self , $ c ) = @ _ ;
my $ r = `nix-store --clear-failed-paths '*'` ;
$ c - > res - > redirect ( "/admin" ) ;
}
2012-04-17 16:53:11 +02:00
2010-04-27 14:11:08 +00:00
sub clearvcscache : Chained('admin') Path('clear-vcs-cache') Args(0) {
2010-04-27 13:29:08 +00:00
my ( $ self , $ c ) = @ _ ;
print "Clearing path cache\n" ;
$ c - > model ( 'DB::CachedPathInputs' ) - > delete_all ;
2011-04-01 07:40:06 +00:00
2010-04-27 13:29:08 +00:00
print "Clearing git cache\n" ;
$ c - > model ( 'DB::CachedGitInputs' ) - > delete_all ;
print "Clearing subversion cache\n" ;
$ c - > model ( 'DB::CachedSubversionInputs' ) - > delete_all ;
2011-02-08 13:11:08 +00:00
print "Clearing bazaar cache\n" ;
$ c - > model ( 'DB::CachedBazaarInputs' ) - > delete_all ;
2010-04-27 13:29:08 +00:00
$ c - > res - > redirect ( "/admin" ) ;
}
2012-04-17 16:53:11 +02:00
2010-04-27 14:11:08 +00:00
sub managenews : Chained('admin') Path('news') Args(0) {
2010-04-27 13:29:08 +00:00
my ( $ self , $ c ) = @ _ ;
$ c - > stash - > { newsItems } = [ $ c - > model ( 'DB::NewsItems' ) - > search ( { } , { order_by = > 'createtime DESC' } ) ] ;
2011-04-01 07:40:06 +00:00
$ c - > stash - > { template } = 'news.tt' ;
2010-04-27 13:29:08 +00:00
}
2012-04-17 16:53:11 +02:00
2010-04-27 14:11:08 +00:00
sub news_submit : Chained('admin') Path('news/submit') Args(0) {
2010-04-27 13:29:08 +00:00
my ( $ self , $ c ) = @ _ ;
requirePost ( $ c ) ;
2011-04-01 07:40:06 +00:00
2010-04-27 13:29:08 +00:00
my $ contents = trim $ c - > request - > params - > { "contents" } ;
my $ createtime = time ;
2011-04-01 07:40:06 +00:00
2010-04-27 13:29:08 +00:00
$ c - > model ( 'DB::NewsItems' ) - > create ( {
createtime = > $ createtime ,
contents = > $ contents ,
author = > $ c - > user - > username
} ) ;
$ c - > res - > redirect ( "/admin/news" ) ;
}
2012-04-17 16:53:11 +02:00
2010-04-27 14:11:08 +00:00
sub news_delete : Chained('admin') Path('news/delete') Args(1) {
2010-04-27 13:29:08 +00:00
my ( $ self , $ c , $ id ) = @ _ ;
txn_do ( $ c - > model ( 'DB' ) - > schema , sub {
my $ newsItem = $ c - > model ( 'DB::NewsItems' ) - > find ( $ id )
or notFound ( $ c , "Newsitem with id $id doesn't exist." ) ;
$ newsItem - > delete ;
} ) ;
2011-04-01 07:40:06 +00:00
2010-04-27 13:29:08 +00:00
$ c - > res - > redirect ( "/admin/news" ) ;
}
2012-04-17 16:53:11 +02:00
2010-05-18 11:37:01 +00:00
sub force_eval : Chained('admin') Path('eval') Args(2) {
my ( $ self , $ c , $ projectName , $ jobsetName ) = @ _ ;
2011-04-01 07:40:06 +00:00
2010-05-18 11:37:01 +00:00
my $ project = $ c - > model ( 'DB::Projects' ) - > find ( $ projectName )
or notFound ( $ c , "Project $projectName doesn't exist." ) ;
$ c - > stash - > { project } = $ project ;
$ c - > stash - > { jobset_ } = $ project - > jobsets - > search ( { name = > $ jobsetName } ) ;
$ c - > stash - > { jobset } = $ c - > stash - > { jobset_ } - > single
or notFound ( $ c , "Jobset $jobsetName doesn't exist." ) ;
2011-04-01 07:40:06 +00:00
2011-12-02 15:58:26 +01:00
( my $ res , my $ stdout , my $ stderr ) = captureStdoutStderr ( 60 , ( "hydra-evaluator" , $ projectName , $ jobsetName ) ) ;
2011-04-01 07:40:06 +00:00
2010-05-18 11:37:01 +00:00
$ c - > res - > redirect ( "/project/$projectName" ) ;
}
2012-04-17 16:53:11 +02:00
2010-04-27 13:29:08 +00:00
1 ;